Merge remote-tracking branch 'origin/master' into cardinality

aclocal.m4

@@ -1003,6 +1003,38 @@ AC_SUBST([LdHasNoCompactUnwind])
 ])# FP_PROG_LD_NO_COMPACT_UNWIND
 
 
+# FP_PROG_LD_FILELIST
+# -------------------
+
+# Sets the output variable LdHasFilelist to YES if ld supports
+# -filelist, or NO otherwise.
+AC_DEFUN([FP_PROG_LD_FILELIST],
+[
+AC_CACHE_CHECK([whether ld understands -filelist], [fp_cv_ld_has_filelist],
+[
+    echo 'int foo() { return 0; }' > conftest1.c
+    echo 'int bar() { return 0; }' > conftest2.c
+    ${CC-cc} -c conftest1.c
+    ${CC-cc} -c conftest2.c
+    echo conftest1.o  > conftest.o-files
+    echo conftest2.o >> conftest.o-files
+    if ${LdCmd} -r -filelist conftest.o-files -o conftest.o > /dev/null 2>&1
+    then
+        fp_cv_ld_has_filelist=yes
+    else
+        fp_cv_ld_has_filelist=no
+    fi
+    rm -rf conftest*
+])
+if test "$fp_cv_ld_has_filelist" = yes; then
+    LdHasFilelist=YES
+else
+    LdHasFilelist=NO
+fi
+AC_SUBST([LdHasFilelist])
+])# FP_PROG_LD_FILELIST
+
+
 # FP_PROG_AR
 # ----------
 # Sets fp_prog_ar to a (non-Cygwin) path to ar. Exits if no ar can be found

compiler/ghc.mk

@@ -110,6 +110,12 @@ ifeq "$(UseLibFFIForAdjustors)" "YES"
 	@echo 'cLibFFI               = True'                                >> $@
 else
 	@echo 'cLibFFI               = False'                               >> $@
+endif
+	@echo 'cDYNAMIC_GHC_PROGRAMS :: Bool'                               >> $@
+ifeq "$(DYNAMIC_GHC_PROGRAMS)" "YES"
+	@echo 'cDYNAMIC_GHC_PROGRAMS = True'                                >> $@
+else
+	@echo 'cDYNAMIC_GHC_PROGRAMS = False'                               >> $@
 endif
 	@echo done.
 
@@ -483,6 +489,10 @@ $(foreach way,$(compiler_stage3_WAYS),\
 # switch off the recompilation checker for that module:
 compiler/prelude/PrimOp_HC_OPTS  += -fforce-recomp
 
+ifeq "$(DYNAMIC_GHC_PROGRAMS)" "YES"
+compiler/utils/Util_HC_OPTS += -DDYNAMIC_GHC_PROGRAMS
+endif
+
 # LibFFI.hs #includes ffi.h
 ifneq "$(UseSystemLibFFI)" "YES"
 compiler/stage2/build/LibFFI.hs : $(libffi_HEADERS)

compiler/ghci/Linker.lhs

@@ -414,14 +414,14 @@ preloadLib dflags lib_paths framework_paths lib_spec
     preload_static _paths name
        = do b <- doesFileExist name
             if not b then return False
-                     else do if dYNAMIC_BY_DEFAULT dflags
+                     else do if cDYNAMIC_GHC_PROGRAMS
                                  then dynLoadObjs dflags [name]
                                  else loadObj name
                              return True
     preload_static_archive _paths name
        = do b <- doesFileExist name
             if not b then return False
-                     else do if dYNAMIC_BY_DEFAULT dflags
+                     else do if cDYNAMIC_GHC_PROGRAMS
                                  then panic "Loading archives not supported"
                                  else loadArchive name
                              return True
@@ -482,13 +482,10 @@ dieWith :: DynFlags -> SrcSpan -> MsgDoc -> IO a
 dieWith dflags span msg = throwGhcExceptionIO (ProgramError (showSDoc dflags (mkLocMessage SevFatal span msg)))
 
 
-checkNonStdWay :: DynFlags -> SrcSpan -> IO Bool
-checkNonStdWay dflags srcspan = do
-  let tag = buildTag dflags
-      dynamicByDefault = dYNAMIC_BY_DEFAULT dflags
-  if (null tag && not dynamicByDefault) ||
-     (tag == "dyn" && dynamicByDefault)
-      then return False
+checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe FilePath)
+checkNonStdWay dflags srcspan =
+  if interpWays == haskellWays
+      then return Nothing
     -- see #3604: object files compiled for way "dyn" need to link to the
     -- dynamic packages, so we can't load them into a statically-linked GHCi.
     -- we have to treat "dyn" in the same way as "prof".
@@ -498,23 +495,28 @@ checkNonStdWay dflags srcspan = do
     -- .o files or -dynamic .o files into GHCi (currently that's not possible
     -- because the dynamic objects contain refs to e.g. __stginit_base_Prelude_dyn
     -- whereas we have __stginit_base_Prelude_.
-      else if (objectSuf dflags == normalObjectSuffix) && not (null tag)
+      else if objectSuf dflags == normalObjectSuffix && not (null haskellWays)
       then failNonStd dflags srcspan
-      else return True
+      else return $ Just $ if cDYNAMIC_GHC_PROGRAMS
+                           then "dyn_o"
+                           else "o"
+    where haskellWays = filter (not . wayRTSOnly) (ways dflags)
 
 normalObjectSuffix :: String
 normalObjectSuffix = phaseInputExt StopLn
 
-failNonStd :: DynFlags -> SrcSpan -> IO Bool
+failNonStd :: DynFlags -> SrcSpan -> IO (Maybe FilePath)
 failNonStd dflags srcspan = dieWith dflags srcspan $
   ptext (sLit "Dynamic linking required, but this is a non-standard build (eg. prof).") $$
-  ptext (sLit "You need to build the program twice: once the normal way, and then") $$
+  ptext (sLit "You need to build the program twice: once the") <+> ghciWay <+> ptext (sLit "way, and then") $$
   ptext (sLit "in the desired way using -osuf to set the object file suffix.")
-
+    where ghciWay = if cDYNAMIC_GHC_PROGRAMS
+                    then ptext (sLit "dynamic")
+                    else ptext (sLit "normal")
 
 getLinkDeps :: HscEnv -> HomePackageTable
             -> PersistentLinkerState
-            -> Bool                             -- replace object suffices?
+            -> Maybe FilePath                   -- replace object suffices?
             -> SrcSpan                          -- for error messages
             -> [Module]                         -- If you need these
             -> IO ([Linkable], [PackageId])     -- ... then link these first
@@ -542,7 +544,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
         --     This will either be in the HPT or (in the case of one-shot
         --     compilation) we may need to use maybe_getFileLinkable
         let { osuf = objectSuf dflags } ;
-        lnks_needed <- mapM (get_linkable osuf replace_osuf) mods_needed ;
+        lnks_needed <- mapM (get_linkable osuf) mods_needed ;
 
         return (lnks_needed, pkgs_needed) }
   where
@@ -607,7 +609,7 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
 
         -- This one is a build-system bug
 
-    get_linkable osuf replace_osuf mod_name      -- A home-package module
+    get_linkable osuf mod_name      -- A home-package module
         | Just mod_info <- lookupUFM hpt mod_name
         = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
         | otherwise
@@ -627,34 +629,26 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
               }}
 
             adjust_linkable lnk
-                | replace_osuf = do
-                        new_uls <- mapM adjust_ul (linkableUnlinked lnk)
+                | Just new_osuf <- replace_osuf = do
+                        new_uls <- mapM (adjust_ul new_osuf)
+                                        (linkableUnlinked lnk)
                         return lnk{ linkableUnlinked=new_uls }
                 | otherwise =
                         return lnk
 
-            adjust_ul (DotO file) = do
+            adjust_ul new_osuf (DotO file) = do
                 MASSERT (osuf `isSuffixOf` file)
                 let file_base = reverse (drop (length osuf + 1) (reverse file))
-                    dyn_file = file_base <.> "dyn_o"
-                    new_file = file_base <.> normalObjectSuffix
-                -- Note that even if dYNAMIC_BY_DEFAULT is on, we might
-                -- still have dynamic object files called .o, so we need
-                -- to try both filenames.
-                use_dyn <- if dYNAMIC_BY_DEFAULT dflags
-                           then do doesFileExist dyn_file
-                           else return False
-                if use_dyn
-                    then return (DotO dyn_file)
-                    else do ok <- doesFileExist new_file
-                            if (not ok)
-                               then dieWith dflags span $
-                                      ptext (sLit "cannot find normal object file ")
-                                            <> quotes (text new_file) $$ while_linking_expr
-                               else return (DotO new_file)
-            adjust_ul (DotA fp) = panic ("adjust_ul DotA " ++ show fp)
-            adjust_ul (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp)
-            adjust_ul l@(BCOs {}) = return l
+                    new_file = file_base <.> new_osuf
+                ok <- doesFileExist new_file
+                if (not ok)
+                   then dieWith dflags span $
+                          ptext (sLit "cannot find normal object file ")
+                                <> quotes (text new_file) $$ while_linking_expr
+                   else return (DotO new_file)
+            adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp)
+            adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp)
+            adjust_ul _ l@(BCOs {}) = return l
 \end{code}
 
 
@@ -790,7 +784,7 @@ dynLinkObjs dflags pls objs = do
             unlinkeds                = concatMap linkableUnlinked new_objs
             wanted_objs              = map nameOfObject unlinkeds
 
-        if dYNAMIC_BY_DEFAULT dflags
+        if cDYNAMIC_GHC_PROGRAMS
             then do dynLoadObjs dflags wanted_objs
                     return (pls, Succeeded)
             else do mapM_ loadObj wanted_objs
@@ -1185,7 +1179,7 @@ locateLib dflags is_hs dirs lib
     --
   = findDll `orElse` findArchive `orElse` tryGcc `orElse` assumeDll
 
-  | not isDynamicGhcLib
+  | not cDYNAMIC_GHC_PROGRAMS
     -- When the GHC package was not compiled as dynamic library
     -- (=DYNAMIC not set), we search for .o libraries or, if they
     -- don't exist, .a libraries.
@@ -1194,13 +1188,11 @@ locateLib dflags is_hs dirs lib
   | otherwise
     -- When the GHC package was compiled as dynamic library (=DYNAMIC set),
     -- we search for .so libraries first.
-  = findHSDll `orElse` findDynObject `orElse` findDynArchive `orElse`
-                       findObject    `orElse` findArchive `orElse` assumeDll
+  = findHSDll `orElse` findDynObject `orElse` assumeDll
    where
      mk_obj_path      dir = dir </> (lib <.> "o")
      mk_dyn_obj_path  dir = dir </> (lib <.> "dyn_o")
      mk_arch_path     dir = dir </> ("lib" ++ lib <.> "a")
-     mk_dyn_arch_path dir = dir </> ("lib" ++ lib <.> "dyn_a")
 
      hs_dyn_lib_name = lib ++ "-ghc" ++ cProjectVersion
      mk_hs_dyn_lib_path dir = dir </> mkSOName platform hs_dyn_lib_name
@@ -1209,10 +1201,8 @@ locateLib dflags is_hs dirs lib
      mk_dyn_lib_path dir = dir </> so_name
 
      findObject     = liftM (fmap Object)  $ findFile mk_obj_path        dirs
-     findDynObject  = do putStrLn "In findDynObject"
-                         liftM (fmap Object)  $ findFile mk_dyn_obj_path    dirs
+     findDynObject  = liftM (fmap Object)  $ findFile mk_dyn_obj_path    dirs
      findArchive    = liftM (fmap Archive) $ findFile mk_arch_path       dirs
-     findDynArchive = liftM (fmap Archive) $ findFile mk_dyn_arch_path   dirs
      findHSDll      = liftM (fmap DLLPath) $ findFile mk_hs_dyn_lib_path dirs
      findDll        = liftM (fmap DLLPath) $ findFile mk_dyn_lib_path    dirs
      tryGcc         = liftM (fmap DLLPath) $ searchForLibUsingGcc dflags so_name dirs

compiler/iface/LoadIface.lhs

@@ -547,7 +547,7 @@ findAndReadIface doc_str mod hi_boot_file
                                            (moduleName mod) err))
     where read_file file_path = do
               traceIf (ptext (sLit "readIFace") <+> text file_path)
-              read_result <- readIface mod file_path hi_boot_file
+              read_result <- readIface mod file_path
               case read_result of
                 Failed err -> return (Failed (badIfaceFile file_path err))
                 Succeeded iface 
@@ -579,12 +579,12 @@ findAndReadIface doc_str mod hi_boot_file
 @readIface@ tries just the one file.
 
 \begin{code}
-readIface :: Module -> FilePath -> IsBootInterface 
+readIface :: Module -> FilePath
           -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
         -- Failed err    <=> file not found, or unreadable, or illegible
         -- Succeeded iface <=> successfully found and parsed 
 
-readIface wanted_mod file_path _
+readIface wanted_mod file_path
   = do  { res <- tryMostM $
                  readBinIface CheckHiWay QuietBinIFaceReading file_path
         ; case res of

compiler/iface/MkIface.lhs

@@ -1121,7 +1121,7 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface
 
         loadIface = do
              let iface_path = msHiFilePath mod_summary
-             read_result <- readIface (ms_mod mod_summary) iface_path False
+             read_result <- readIface (ms_mod mod_summary) iface_path
              case read_result of
                  Failed err -> do
                      traceIf (text "FYI: cannot read old interface file:" $$ nest 4 err)

compiler/main/DriverPipeline.hs

@@ -2134,6 +2134,12 @@ joinObjectFiles dflags o_files output_fn = do
           script <- newTempName dflags "ldscript"
           writeFile script $ "INPUT(" ++ unwords o_files ++ ")"
           ld_r [SysTools.FileOption "" script]
+     else if sLdSupportsFilelist mySettings
+     then do
+          filelist <- newTempName dflags "filelist"
+          writeFile filelist $ unlines o_files
+          ld_r [SysTools.Option "-Wl,-filelist",
+                SysTools.FileOption "-Wl," filelist]
      else do
           ld_r (map (SysTools.FileOption "") o_files)