Fix CodingStyle#Warnings URLs
[ghc-hetmet.git] / compiler / main / DriverPipeline.hs
index e9fb307..ceb0b3b 100644 (file)
@@ -6,6 +6,13 @@
 --
 -----------------------------------------------------------------------------
 
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 module DriverPipeline (
        -- Run a series of compilation steps in a pipeline, for a
        -- collection of source files.
@@ -327,7 +334,6 @@ link LinkBinary dflags batch_attempt_linking hpt
                                 text "   Main.main not exported; not linking.")
         return Succeeded
       
-
 -- -----------------------------------------------------------------------------
 -- Compile files in one-shot mode.
 
@@ -413,12 +419,16 @@ runPipeline
   -> Maybe ModLocation          -- A ModLocation, if this is a Haskell module
   -> IO (DynFlags, FilePath)   -- (final flags, output filename)
 
-runPipeline stop_phase dflags (input_fn, mb_phase) mb_basename output maybe_loc
+runPipeline stop_phase dflags0 (input_fn, mb_phase) mb_basename output maybe_loc
   = do
-  let (input_basename, suffix) = splitFilename input_fn
+  let
+      (input_basename, suffix) = splitFilename input_fn
       basename | Just b <- mb_basename = b
                | otherwise             = input_basename
 
+      -- Decide where dump files should go based on the pipeline output
+      dflags = dflags0 { dumpPrefix = Just (basename ++ ".") }
+
        -- If we were given a -x flag, then use that phase to start from
       start_phase = fromMaybe (startPhase suffix) mb_phase
 
@@ -811,6 +821,7 @@ runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc
                              (cmdline_include_paths ++ pkg_include_dirs)
 
        let (md_c_flags, md_regd_c_flags) = machdepCCOpts dflags
+        gcc_extra_viac_flags <- getExtraViaCOpts dflags
         let pic_c_flags = picCCOpts dflags
 
         let verb = getVerbFlag dflags
@@ -877,6 +888,13 @@ runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc
                       ++ (if hcc && mangle
                             then md_regd_c_flags
                             else [])
+                      ++ (if hcc
+                            then if mangle 
+                                     then gcc_extra_viac_flags
+                                     else filter (=="-fwrapv")
+                                                gcc_extra_viac_flags
+                                -- still want -fwrapv even for unreg'd
+                            else [])
                       ++ (if hcc 
                             then more_hcc_opts
                             else [])
@@ -886,10 +904,6 @@ runPhase cc_phase stop dflags basename suff input_fn get_output_fn maybe_loc
                       ++ split_opt
                       ++ include_paths
                       ++ pkg_extra_cc_opts
-#ifdef HAVE_GCC_HAS_WRAPV
-                  -- We need consistent integer overflow (trac #952)
-               ++ ["-fwrapv"]
-#endif
                       ))
 
        return (next_phase, dflags, maybe_loc, output_fn)
@@ -1227,6 +1241,8 @@ linkBinary dflags o_files dep_packages = do
                        ]
                    | otherwise               = []
 
+    rc_objs <- maybeCreateManifest dflags output_fn
+
     let (md_c_flags, _) = machdepCCOpts dflags
     SysTools.runLink dflags ( 
                       [ SysTools.Option verb
@@ -1239,6 +1255,7 @@ linkBinary dflags o_files dep_packages = do
                      ++ extra_ld_inputs
                      ++ lib_path_opts
                      ++ extra_ld_opts
+                      ++ rc_objs
 #ifdef darwin_TARGET_OS
                      ++ framework_path_opts
                      ++ framework_opts
@@ -1277,6 +1294,59 @@ exeFileName dflags
        "a.out"
 #endif
 
+maybeCreateManifest
+   :: DynFlags
+   -> FilePath                          -- filename of executable
+   -> IO [FilePath]                     -- extra objects to embed, maybe
+maybeCreateManifest dflags exe_filename = do
+#ifndef mingw32_TARGET_OS
+  return []
+#else
+  if not (dopt Opt_GenManifest dflags) then return [] else do
+
+  let manifest_filename = exe_filename `joinFileExt` "manifest"
+
+  writeFile manifest_filename $ 
+      "<?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=\"" ++ basenameOf 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"
+
+  -- Windows will fine 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 (dopt Opt_EmbedManifest dflags) then return [] else do
+
+  rc_filename <- newTempName dflags "rc"
+  rc_obj_filename <- newTempName dflags (objectSuf dflags)
+
+  writeFile rc_filename $
+      "1 24 MOVEABLE PURE \"" ++ manifest_filename ++ "\"\n"
+        -- magic numbers :-)
+
+  let wr_opts = getOpts dflags opt_windres
+  runWindres dflags $ map SysTools.Option $
+        ["--input="++rc_filename, 
+         "--output="++rc_obj_filename,
+         "--output-format=coff"] 
+        ++ wr_opts
+        -- no FileOptions here: windres doesn't like seeing
+        -- backslashes, apparently
+
+  return [rc_obj_filename]
+#endif
+
+
 linkDynLib :: DynFlags -> [String] -> [PackageId] -> IO ()
 linkDynLib dflags o_files dep_packages = do
     let verb = getVerbFlag dflags
@@ -1296,49 +1366,85 @@ linkDynLib dflags o_files dep_packages = do
     extra_ld_inputs <- readIORef v_Ld_inputs
 
     let (md_c_flags, _) = machdepCCOpts dflags
+    let extra_ld_opts = getOpts dflags opt_l
 #if defined(mingw32_HOST_OS)
     -----------------------------------------------------------------------------
     -- Making a DLL
     -----------------------------------------------------------------------------
-
     let output_fn = case o_file of { Just s -> s; Nothing -> "HSdll.dll"; }
 
-    -- opts from -optdll-<blah>
-    let extra_ld_opts = getOpts dflags opt_dll 
+    SysTools.runLink dflags
+        ([ SysTools.Option verb
+         , SysTools.Option "-o"
+         , SysTools.FileOption "" output_fn
+         , SysTools.Option "-shared"
+         , SysTools.Option "-Wl,--export-all-symbols"
+         , SysTools.FileOption "-Wl,--out-implib=" (output_fn ++ ".a")
+         ]
+        ++ map (SysTools.FileOption "") o_files
+        ++ map SysTools.Option (
+           md_c_flags
+        ++ extra_ld_inputs
+        ++ lib_path_opts
+        ++ extra_ld_opts
+        ++ pkg_lib_path_opts
+        ++ pkg_link_opts
+       ))
+#elif defined(darwin_TARGET_OS)
+    -----------------------------------------------------------------------------
+    -- Making a darwin dylib
+    -----------------------------------------------------------------------------
+    -- About the options used for Darwin:
+    -- -dynamiclib
+    --   Apple's way of saying -shared
+    -- -undefined dynamic_lookup:
+    --   Without these options, we'd have to specify the correct dependencies
+    --   for each of the dylibs. Note that we could (and should) do without this
+    --  for all libraries except the RTS; all we need to do is to pass the
+    --  correct HSfoo_dyn.dylib files to the link command.
+    --  This feature requires Mac OS X 10.3 or later; there is a similar feature,
+    --  -flat_namespace -undefined suppress, which works on earlier versions,
+    --  but it has other disadvantages.
+    -- -single_module
+    --  Build the dynamic library as a single "module", i.e. no dynamic binding
+    --  nonsense when referring to symbols from within the library. The NCG
+    --  assumes that this option is specified (on i386, at least).
+    -- -Wl,-macosx_version_min -Wl,10.3
+    --  Tell the linker its safe to assume that the library will run on 10.3 or
+    --  later, so that it will not complain about the use of the option
+    --  -undefined dynamic_lookup above.
+    -- -install_name
+    --   Causes the dynamic linker to ignore the DYLD_LIBRARY_PATH when loading
+    --   this lib and instead look for it at its absolute path.
+    --   When installing the .dylibs (see target.mk), we'll change that path to
+    --   point to the place they are installed. Therefore, we won't have to set
+    --  up DYLD_LIBRARY_PATH specifically for ghc.
+    -----------------------------------------------------------------------------
 
-    let pstate = pkgState dflags
-       rts_pkg  = getPackageDetails pstate rtsPackageId
-        base_pkg = getPackageDetails pstate basePackageId
+    let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 
-    let extra_os = if static || no_hs_main
-                   then []
-                   else [ head (libraryDirs rts_pkg) ++ "/Main.dll_o",
-                          head (libraryDirs base_pkg) ++ "/PrelMain.dll_o" ]
-    SysTools.runMkDLL dflags
+    pwd <- getCurrentDirectory
+    SysTools.runLink dflags
         ([ SysTools.Option verb
+         , SysTools.Option "-dynamiclib"
          , SysTools.Option "-o"
          , SysTools.FileOption "" output_fn
          ]
         ++ map SysTools.Option (
            md_c_flags
         ++ o_files
-        ++ extra_os
-        ++ [ "--target=i386-mingw32" ]
+        ++ [ "-undefined", "dynamic_lookup", "-single_module", "-Wl,-macosx_version_min","-Wl,10.3", "-install_name " ++ (pwd `joinFileName` output_fn) ]
         ++ extra_ld_inputs
         ++ lib_path_opts
         ++ extra_ld_opts
         ++ pkg_lib_path_opts
         ++ pkg_link_opts
-         ++ (if "--def" `elem` (concatMap words extra_ld_opts)
-              then [ "" ]
-               else [ "--export-all" ])
        ))
 #else
     -----------------------------------------------------------------------------
     -- Making a DSO
     -----------------------------------------------------------------------------
-    -- opts from -optl-<blah>
-    let extra_ld_opts = getOpts dflags opt_l 
+
     let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
 
     SysTools.runLink dflags