Linker: reorganize linker related code

Move linker related code into GHC.Linker. Previously it was scattered
into GHC.Unit.State, GHC.Driver.Pipeline, GHC.Runtime.Linker, etc.

Add documentation in GHC.Linker

1 files changed, 64 insertions, 0 deletions

diff --git a/compiler/GHC/Linker/Windows.hs b/compiler/GHC/Linker/Windows.hs
new file mode 100644
index 0000000000..3bbe83f10e
--- /dev/null
+++ b/compiler/GHC/Linker/Windows.hs
@@ -0,0 +1,64 @@
+module GHC.Linker.Windows
+   ( maybeCreateManifest
+   )
+where
+
+import GHC.Prelude
+import GHC.SysTools
+import GHC.Driver.Session
+import GHC.SysTools.FileCleanup
+
+import System.FilePath
+import System.Directory
+
+maybeCreateManifest
+   :: DynFlags
+   -> FilePath      -- ^ filename of executable
+   -> IO [FilePath] -- ^ extra objects to embed, maybe
+maybeCreateManifest dflags exe_filename = do
+   let manifest_filename = exe_filename <.> "manifest"
+       manifest =
+         "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n\
+         \  <assembly xmlns=\"urn:schemas-microsoft-com:asm.v1\" manifestVersion=\"1.0\">\n\
+         \  <assemblyIdentity version=\"1.0.0.0\"\n\
+         \     processorArchitecture=\"X86\"\n\
+         \     name=\"" ++ dropExtension exe_filename ++ "\"\n\
+         \     type=\"win32\"/>\n\n\
+         \  <trustInfo xmlns=\"urn:schemas-microsoft-com:asm.v3\">\n\
+         \    <security>\n\
+         \      <requestedPrivileges>\n\
+         \        <requestedExecutionLevel level=\"asInvoker\" uiAccess=\"false\"/>\n\
+         \        </requestedPrivileges>\n\
+         \       </security>\n\
+         \  </trustInfo>\n\
+         \</assembly>\n"
+
+   writeFile manifest_filename manifest
+
+   -- Windows will find the manifest file if it is named
+   -- foo.exe.manifest. However, for extra robustness, and so that
+   -- we can move the binary around, we can embed the manifest in
+   -- the binary itself using windres:
+   if not (gopt Opt_EmbedManifest dflags)
+      then return []
+      else do
+         rc_filename <- newTempName dflags TFL_CurrentModule "rc"
+         rc_obj_filename <-
+           newTempName dflags TFL_GhcSession (objectSuf dflags)
+
+         writeFile rc_filename $
+             "1 24 MOVEABLE PURE " ++ show manifest_filename ++ "\n"
+               -- magic numbers :-)
+               -- show is a bit hackish above, but we need to escape the
+               -- backslashes in the path.
+
+         runWindres dflags $ map GHC.SysTools.Option $
+               ["--input="++rc_filename,
+                "--output="++rc_obj_filename,
+                "--output-format=coff"]
+               -- no FileOptions here: windres doesn't like seeing
+               -- backslashes, apparently
+
+         removeFile manifest_filename
+
+         return [rc_obj_filename]