X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fghci%2FLinker.lhs;h=1ac21e3363f274c6a566bc96e2e0241c9cf41844;hb=66994acb3d88236e6a4def84f7162c95ed5945d2;hp=008c0b2e93d443391883e9029afbcec3e73a8544;hpb=98688c6e8fd33f31c51218cf93cbf03fe3a5e73d;p=ghc-hetmet.git

diff --git a/ghc/compiler/ghci/Linker.lhs b/ghc/compiler/ghci/Linker.lhs
index 008c0b2..1ac21e3 100644
--- a/ghc/compiler/ghci/Linker.lhs
+++ b/ghc/compiler/ghci/Linker.lhs
@@ -15,12 +15,12 @@ necessary.
 
 {-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
 
-module Linker ( HValue, initDynLinker, showLinkerState,
+module Linker ( HValue, showLinkerState,
 		linkExpr, unload, extendLinkEnv, 
 		linkPackages,
 	) where
 
-#include "../includes/config.h"
+#include "../includes/ghcconfig.h"
 #include "HsVersions.h"
 
 import ObjLink		( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
@@ -30,6 +30,7 @@ import ByteCodeAsm	( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
 
 import Packages
 import DriverState	( v_Library_paths, v_Opt_l, v_Ld_inputs, getStaticOpts, v_ExplicitPackages )
+import DriverPhases	( isObjectFilename, isDynLibFilename )
 import DriverUtil	( getFileSuffix )
 #ifdef darwin_TARGET_OS
 import DriverState	( v_Cmdline_frameworks, v_Framework_paths )
@@ -214,7 +215,7 @@ reallyInitDynLinker
 	; lib_paths <- readIORef v_Library_paths
 	; cmdline_ld_inputs <- readIORef v_Ld_inputs
 
-	; let (cmdline_libs, cmdline_objs) = partition libish cmdline_ld_inputs
+	; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs
 
 	   	-- (e) Link any MacOS frameworks
 #ifdef darwin_TARGET_OS	
@@ -225,8 +226,7 @@ reallyInitDynLinker
 	; let framework_paths = []
 #endif
 		-- Finally do (c),(d),(e)	
-        ; let cmdline_lib_specs = map Object    cmdline_objs
-			       ++ map DLLPath   cmdline_libs
+        ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ]
 			       ++ map DLL       minus_ls 
 			       ++ map Framework frameworks
 	; if null cmdline_lib_specs then return ()
@@ -240,16 +240,13 @@ reallyInitDynLinker
 	  else throwDyn (InstallationError "linking extra libraries/objects failed")
 	}}
 
-libish :: String -> Bool
-libish f = getFileSuffix f `elem` dynlib_suffixes
-
-#ifdef mingw32_TARGET_OS
-dynlib_suffixes = ["dll", "DLL"]
-#elif defined(darwin_TARGET_OS)
-dynlib_suffixes = ["dylib"]
-#else
-dynlib_suffixes = ["so"]
-#endif
+classifyLdInput :: FilePath -> IO (Maybe LibrarySpec)
+classifyLdInput f
+  | isObjectFilename f = return (Just (Object f))
+  | isDynLibFilename f = return (Just (DLLPath f))
+  | otherwise 	       = do
+	hPutStrLn stderr ("Warning: ignoring unrecognised input `" ++ f ++ "'")
+	return Nothing
 
 preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
 preloadLib dflags lib_paths framework_paths lib_spec
@@ -708,7 +705,7 @@ partOfGHCi
 #          if defined(mingw32_TARGET_OS) || defined(darwin_TARGET_OS)
            = [ ]
 #          else
-           = [ "base", "haskell98", "haskell-src", "readline" ]
+           = [ "base", "haskell98", "template-haskell", "readline" ]
 #          endif
 
 showLS (Object nm)    = "(static) " ++ nm
@@ -760,29 +757,40 @@ linkPackages dflags new_pkgs
 linkPackage :: DynFlags -> PackageConfig -> IO ()
 linkPackage dflags pkg
    = do 
-        let dirs      =  Packages.library_dirs pkg
-        let libs      =  Packages.hs_libraries pkg ++ extra_libraries pkg
-				++ [ lib | '-':'l':lib <- extra_ld_opts pkg ]
+        let dirs      =  Packages.libraryDirs pkg
+        let libs      =  Packages.hsLibraries pkg ++ Packages.extraLibraries pkg
+				++ [ lib | '-':'l':lib <- Packages.extraLdOpts pkg ]
         classifieds   <- mapM (locateOneObj dirs) libs
 
         -- Complication: all the .so's must be loaded before any of the .o's.  
 	let dlls = [ dll | DLL dll    <- classifieds ]
 	    objs = [ obj | Object obj <- classifieds ]
 
-	maybePutStr dflags ("Loading package " ++ Packages.name pkg ++ " ... ")
+	maybePutStr dflags ("Loading package " ++ showPackageId (package pkg) ++ " ... ")
 
 	-- See comments with partOfGHCi
-	when (Packages.name pkg `notElem` partOfGHCi) $ do
+	when (pkgName (package pkg) `notElem` partOfGHCi) $ do
 	    loadFrameworks pkg
-	    mapM_ (load_dyn dirs) dlls
+            -- When a library A needs symbols from a library B, the order in
+            -- extra_libraries/extra_ld_opts is "-lA -lB", because that's the
+            -- way ld expects it for static linking. Dynamic linking is a
+            -- different story: When A has no dependency information for B,
+            -- dlopen-ing A with RTLD_NOW (see addDLL in Linker.c) will fail
+            -- when B has not been loaded before. In a nutshell: Reverse the
+            -- order of DLLs for dynamic linking.
+	    -- This fixes a problem with the HOpenGL package (see "Compiling
+	    -- HOpenGL under recent versions of GHC" on the HOpenGL list).
+	    mapM_ (load_dyn dirs) (reverse dlls)
 	
 	-- After loading all the DLLs, we can load the static objects.
+	-- Ordering isn't important here, because we do one final link
+	-- step to resolve everything.
 	mapM_ loadObj objs
 
         maybePutStr dflags "linking ... "
         ok <- resolveObjs
 	if succeeded ok then maybePutStrLn dflags "done."
-	      else panic ("can't load package `" ++ name pkg ++ "'")
+	      else throwDyn (InstallationError ("unable to load package `" ++ showPackageId (package pkg) ++ "'"))
 
 load_dyn dirs dll = do r <- loadDynamic dirs dll
 		       case r of
@@ -794,8 +802,8 @@ loadFrameworks pkg = return ()
 #else
 loadFrameworks pkg = mapM_ load frameworks
   where
-    fw_dirs    = Packages.framework_dirs pkg
-    frameworks = Packages.extra_frameworks pkg
+    fw_dirs    = Packages.frameworkDirs pkg
+    frameworks = Packages.extraFrameworks pkg
 
     load fw = do  r <- loadFramework fw_dirs fw
 		  case r of