[project @ 2005-01-14 08:01:26 by wolfgang]
[ghc-hetmet.git] / ghc / compiler / ghci / Linker.lhs
index d71bcd7..f897eec 100644 (file)
@@ -13,34 +13,36 @@ necessary.
 
 \begin{code}
 
-{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
+{-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
 
-module Linker ( HValue, initLinker, showLinkerState,
-               linkLibraries, linkExpr,
-               unload, extendLinkEnv, 
-               LibrarySpec(..)
+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, initLinker )
+import ObjLink         ( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
 import ByteCodeLink    ( HValue, ClosureEnv, extendClosureEnv, linkBCO )
 import ByteCodeItbls   ( ItblEnv )
 import ByteCodeAsm     ( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
 
 import Packages
-import DriverState     ( v_Library_paths, v_Opt_l, getPackageConfigMap,
-                         getStaticOpts )
-import Finder          ( findModule, findLinkable )
+import DriverState     ( v_Library_paths, v_Opt_l, v_Ld_inputs, getStaticOpts )
+import DriverPhases    ( isObjectFilename, isDynLibFilename )
+import DriverUtil      ( getFileSuffix )
+#ifdef darwin_TARGET_OS
+import DriverState     ( v_Cmdline_frameworks, v_Framework_paths )
+#endif
+import Finder          ( findModule, findLinkable, FindResult(..) )
 import HscTypes
-import Name            ( Name,  nameModule, isExternalName )
+import Name            ( Name, nameModule, isExternalName, isWiredInName )
 import NameEnv
 import NameSet         ( nameSetToList )
 import Module
-import FastString      ( FastString(..), unpackFS )
 import ListSetOps      ( minusList )
-import CmdLineOpts     ( DynFlags(verbosity) )
+import CmdLineOpts     ( DynFlags(..) )
 import BasicTypes      ( SuccessFlag(..), succeeded, failed )
 import Outputable
 import Panic            ( GhcException(..) )
@@ -79,7 +81,8 @@ The PersistentLinkerState maps Names to actual closures (for
 interpreted code only), for use during linking.
 
 \begin{code}
-GLOBAL_VAR(v_PersistentLinkerState, emptyPLS, PersistentLinkerState)
+GLOBAL_VAR(v_PersistentLinkerState, panic "Dynamic linker not initialised", PersistentLinkerState)
+GLOBAL_VAR(v_InitLinkerDone, False, Bool)      -- Set True when dynamic linker is initialised
 
 data PersistentLinkerState
    = PersistentLinkerState {
@@ -103,19 +106,25 @@ data PersistentLinkerState
        -- The currently-loaded packages; always object code
        -- Held, as usual, in dependency order; though I am not sure if
        -- that is really important
-       pkgs_loaded :: [PackageName]
+       pkgs_loaded :: [PackageId]
      }
 
-emptyPLS :: PersistentLinkerState
-emptyPLS = PersistentLinkerState { closure_env = emptyNameEnv,
-                                   itbl_env    = emptyNameEnv,
-                                  pkgs_loaded = init_pkgs_loaded,
-                                  bcos_loaded = [],
-                                  objs_loaded = [] }
+emptyPLS :: DynFlags -> PersistentLinkerState
+emptyPLS dflags = PersistentLinkerState { 
+                       closure_env = emptyNameEnv,
+                       itbl_env    = emptyNameEnv,
+                       pkgs_loaded = init_pkgs,
+                       bcos_loaded = [],
+                       objs_loaded = [] }
+  -- Packages that don't need loading, because the compiler 
+  -- shares them with the interpreted program.
+  --
+  -- The linker's symbol table is populated with RTS symbols using an
+  -- explicit list.  See rts/Linker.c for details.
+  where init_pkgs
+         | Just rts_id <- rtsPackageId (pkgState dflags) = [rts_id]
+         | otherwise = []
 
--- Packages that don't need loading, because the compiler 
--- shares them with the interpreted program.
-init_pkgs_loaded = [ FSLIT("rts") ]
 \end{code}
 
 \begin{code}
@@ -133,12 +142,12 @@ extendLinkEnv new_bindings
 --     (these are the temporary bindings from the command line).
 -- Used to filter both the ClosureEnv and ItblEnv
 
-filterNameMap :: [ModuleName] -> NameEnv (Name, a) -> NameEnv (Name, a)
+filterNameMap :: [Module] -> NameEnv (Name, a) -> NameEnv (Name, a)
 filterNameMap mods env 
    = filterNameEnv keep_elt env
    where
      keep_elt (n,_) = isExternalName n 
-                     && (moduleName (nameModule n) `elem` mods)
+                     && (nameModule n `elem` mods)
 \end{code}
 
 
@@ -155,6 +164,139 @@ showLinkerState
                        
        
 
+
+%************************************************************************
+%*                                                                     *
+\subsection{Initialisation}
+%*                                                                     *
+%************************************************************************
+
+We initialise the dynamic linker by
+
+a) calling the C initialisation procedure
+
+b) Loading any packages specified on the command line,
+   now held in v_ExplicitPackages
+
+c) Loading any packages specified on the command line,
+   now held in the -l options in v_Opt_l
+
+d) Loading any .o/.dll files specified on the command line,
+   now held in v_Ld_inputs
+
+e) Loading any MacOS frameworks
+
+\begin{code}
+initDynLinker :: DynFlags -> IO ()
+-- This function is idempotent; if called more than once, it does nothing
+-- This is useful in Template Haskell, where we call it before trying to link
+initDynLinker dflags
+  = do { done <- readIORef v_InitLinkerDone
+       ; if done then return () 
+                 else do { writeIORef v_InitLinkerDone True
+                         ; reallyInitDynLinker dflags }
+       }
+
+reallyInitDynLinker dflags
+  = do  {  -- Initialise the linker state
+       ; writeIORef v_PersistentLinkerState (emptyPLS dflags)
+
+               -- (a) initialise the C dynamic linker
+       ; initObjLinker 
+
+               -- (b) Load packages from the command-line
+       ; linkPackages dflags (explicitPackages (pkgState dflags))
+
+               -- (c) Link libraries from the command-line
+       ; opt_l  <- getStaticOpts v_Opt_l
+       ; let minus_ls = [ lib | '-':'l':lib <- opt_l ]
+
+               -- (d) Link .o files from the command-line
+       ; lib_paths <- readIORef v_Library_paths
+       ; cmdline_ld_inputs <- readIORef v_Ld_inputs
+
+       ; classified_ld_inputs <- mapM classifyLdInput cmdline_ld_inputs
+
+               -- (e) Link any MacOS frameworks
+#ifdef darwin_TARGET_OS        
+       ; framework_paths <- readIORef v_Framework_paths
+       ; frameworks      <- readIORef v_Cmdline_frameworks
+#else
+       ; let frameworks      = []
+       ; let framework_paths = []
+#endif
+               -- Finally do (c),(d),(e)       
+        ; let cmdline_lib_specs = [ l | Just l <- classified_ld_inputs ]
+                              ++ map DLL       minus_ls 
+                              ++ map Framework frameworks
+       ; if null cmdline_lib_specs then return ()
+                                   else do
+
+       { mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
+       ; maybePutStr dflags "final link ... "
+       ; ok <- resolveObjs
+
+       ; if succeeded ok then maybePutStrLn dflags "done"
+         else throwDyn (InstallationError "linking extra libraries/objects failed")
+       }}
+
+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
+  = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
+       case lib_spec of
+          Object static_ish
+             -> do b <- preload_static lib_paths static_ish
+                   maybePutStrLn dflags (if b  then "done"
+                                               else "not found")
+        
+          DLL dll_unadorned
+             -> do maybe_errstr <- loadDynamic lib_paths dll_unadorned
+                   case maybe_errstr of
+                      Nothing -> maybePutStrLn dflags "done"
+                      Just mm -> preloadFailed mm lib_paths lib_spec
+
+         DLLPath dll_path
+            -> do maybe_errstr <- loadDLL dll_path
+                   case maybe_errstr of
+                      Nothing -> maybePutStrLn dflags "done"
+                      Just mm -> preloadFailed mm lib_paths lib_spec
+
+#ifdef darwin_TARGET_OS
+         Framework framework
+             -> do maybe_errstr <- loadFramework framework_paths framework
+                   case maybe_errstr of
+                      Nothing -> maybePutStrLn dflags "done"
+                      Just mm -> preloadFailed mm framework_paths lib_spec
+#endif
+  where
+    preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
+    preloadFailed sys_errmsg paths spec
+       = do maybePutStr dflags
+              ("failed.\nDynamic linker error message was:\n   " 
+                    ++ sys_errmsg  ++ "\nWhilst trying to load:  " 
+                    ++ showLS spec ++ "\nDirectories to search are:\n"
+                    ++ unlines (map ("   "++) paths) )
+            give_up
+    
+    -- Not interested in the paths in the static case.
+    preload_static paths name
+       = do b <- doesFileExist name
+            if not b then return False
+                     else loadObj name >> return True
+    
+    give_up = throwDyn $ 
+             CmdLineError "user specified .o/.so/.DLL could not be loaded."
+\end{code}
+
+
 %************************************************************************
 %*                                                                     *
                Link a byte-code expression
@@ -162,8 +304,7 @@ showLinkerState
 %************************************************************************
 
 \begin{code}
-linkExpr :: HscEnv -> PersistentCompilerState
-        -> UnlinkedBCO -> IO HValue
+linkExpr :: HscEnv -> UnlinkedBCO -> IO HValue
 
 -- Link a single expression, *including* first linking packages and 
 -- modules that this expression depends on.
@@ -171,14 +312,19 @@ linkExpr :: HscEnv -> PersistentCompilerState
 -- Raises an IO exception if it can't find a compiled version of the
 -- dependents to link.
 
-linkExpr hsc_env pcs root_ul_bco
+linkExpr hsc_env root_ul_bco
   = do {  
+       -- Initialise the linker (if it's not been done already)
+     let dflags = hsc_dflags hsc_env
+   ; initDynLinker dflags
+
        -- Find what packages and linkables are required
-     (lnks, pkgs) <- getLinkDeps hpt pit needed_mods ;
+   ; eps <- readIORef (hsc_EPS hsc_env)
+   ; (lnks, pkgs) <- getLinkDeps dflags hpt (eps_PIT eps) needed_mods
 
        -- Link the packages and modules required
-     linkPackages dflags pkgs
-   ; ok <-  linkModules dflags lnks
+   ; linkPackages dflags pkgs
+   ; ok <- linkModules dflags lnks
    ; if failed ok then
        dieWith empty
      else do {
@@ -193,22 +339,28 @@ linkExpr hsc_env pcs root_ul_bco
    ; return root_hval
    }}
    where
-     pit    = eps_PIT (pcs_EPS pcs)
      hpt    = hsc_HPT hsc_env
      dflags = hsc_dflags hsc_env
      free_names = nameSetToList (bcoFreeNames root_ul_bco)
 
      needed_mods :: [Module]
-     needed_mods = [ nameModule n | n <- free_names, isExternalName n ]
+     needed_mods = [ nameModule n | n <- free_names, 
+                                   isExternalName n,           -- Names from other modules
+                                   not (isWiredInName n)       -- Exclude wired-in names
+                  ]                                            -- (see note below)
+       -- Exclude wired-in names because we may not have read
+       -- their interface files, so getLinkDeps will fail
+       -- All wired-in names are in the base package, which we link
+       -- by default, so we can safely ignore them here.
  
-dieWith msg = throwDyn (UsageError (showSDoc msg))
+dieWith msg = throwDyn (ProgramError (showSDoc msg))
 
-getLinkDeps :: HomePackageTable -> PackageIfaceTable
+getLinkDeps :: DynFlags -> HomePackageTable -> PackageIfaceTable
            -> [Module]                         -- If you need these
-           -> IO ([Linkable], [PackageName])   -- ... then link these first
+           -> IO ([Linkable], [PackageId])     -- ... then link these first
 -- Fails with an IO exception if it can't find enough files
 
-getLinkDeps hpt pit mods
+getLinkDeps dflags hpt pit mods
 -- Find all the packages and linkables that a set of modules depends on
  = do {        pls <- readIORef v_PersistentLinkerState ;
        let {
@@ -220,24 +372,24 @@ getLinkDeps hpt pit mods
            mods_needed = nub (concat mods_s) `minusList` linked_mods     ;
            pkgs_needed = nub (concat pkgs_s) `minusList` pkgs_loaded pls ;
 
-           linked_mods = map linkableModName (objs_loaded pls ++ bcos_loaded pls)
+           linked_mods = map linkableModule (objs_loaded pls ++ bcos_loaded pls)
        } ;
        
        -- 3.  For each dependent module, find its linkable
-       --     This will either be in the HPT or (in the case of one-shot compilation)
-       --     we may need to use maybe_getFileLinkable
+       --     This will either be in the HPT or (in the case of one-shot
+       --     compilation) we may need to use maybe_getFileLinkable
        lnks_needed <- mapM get_linkable mods_needed ;
 
        return (lnks_needed, pkgs_needed) }
   where
-    get_deps :: Module -> ([ModuleName],[PackageName])
+    get_deps :: Module -> ([Module],[PackageId])
        -- Get the things needed for the specified module
        -- This is rather similar to the code in RnNames.importsFromImportDecl
     get_deps mod
-       | isHomeModule (mi_module iface) 
-       = (moduleName mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
+       | ExternalPackage p <- mi_package iface
+       = ([], p : dep_pkgs deps)
        | otherwise
-       = ([], mi_package iface : dep_pkgs deps)
+       = (mod : [m | (m,_) <- dep_mods deps], dep_pkgs deps)
        where
          iface = get_iface mod
          deps  = mi_deps iface
@@ -252,23 +404,25 @@ getLinkDeps hpt pit mods
        -- This one is a build-system bug
 
     get_linkable mod_name      -- A home-package module
-       | Just mod_info <- lookupModuleEnvByName hpt mod_name 
+       | Just mod_info <- lookupModuleEnv hpt mod_name 
        = return (hm_linkable mod_info)
        | otherwise     
        =       -- It's not in the HPT because we are in one shot mode, 
                -- so use the Finder to get a ModLocation...
-         do { mb_stuff <- findModule mod_name ;
+         do { mb_stuff <- findModule dflags mod_name False ;
               case mb_stuff of {
-                 Nothing -> no_obj mod_name ;
-                 Just (_, loc) -> do {
+                 Found loc _ -> found loc mod_name ;
+                 _ -> no_obj mod_name
+            }}
 
+    found loc mod_name = do {
                -- ...and then find the linkable for it
               mb_lnk <- findLinkable mod_name loc ;
               case mb_lnk of {
                  Nothing -> no_obj mod_name ;
                  Just lnk -> return lnk
-         }}}} 
-\end{code}                       
+             }}
+\end{code}
 
 
 %************************************************************************
@@ -310,19 +464,16 @@ partitionLinkable li
             other
                -> [li]
 
-findModuleLinkable_maybe :: [Linkable] -> ModuleName -> Maybe Linkable
+findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
 findModuleLinkable_maybe lis mod
    = case [LM time nm us | LM time nm us <- lis, nm == mod] of
         []   -> Nothing
         [li] -> Just li
         many -> pprPanic "findModuleLinkable" (ppr mod)
 
-filterModuleLinkables :: (ModuleName -> Bool) -> [Linkable] -> [Linkable]
-filterModuleLinkables p ls = filter (p . linkableModName) ls
-
 linkableInSet :: Linkable -> [Linkable] -> Bool
 linkableInSet l objs_loaded =
-  case findModuleLinkable_maybe objs_loaded (linkableModName l) of
+  case findModuleLinkable_maybe objs_loaded (linkableModule l) of
        Nothing -> False
        Just m  -> linkableTime l == linkableTime m
 \end{code}
@@ -375,67 +526,6 @@ rmDupLinkables already ls
        | otherwise               = go (l:already) (l:extras) ls
 \end{code}
 
-
-\begin{code}
-linkLibraries :: DynFlags 
-             -> [String]       -- foo.o files specified on command line
-             -> IO ()
--- Used just at initialisation time to link in libraries
--- specified on the command line. 
-linkLibraries dflags objs
-   = do        { lib_paths <- readIORef v_Library_paths
-       ; opt_l  <- getStaticOpts v_Opt_l
-       ; let minus_ls = [ lib | '-':'l':lib <- opt_l ]
-        ; let cmdline_lib_specs = map Object objs ++ map DLL minus_ls
-       
-       ; if (null cmdline_lib_specs) then return () 
-         else do {
-
-               -- Now link them
-       ; mapM_ (preloadLib dflags lib_paths) cmdline_lib_specs
-
-       ; maybePutStr dflags "final link ... "
-       ; ok <- resolveObjs
-       ; if succeeded ok then maybePutStrLn dflags "done."
-         else throwDyn (InstallationError "linking extra libraries/objects failed")
-       }}
-     where
-        preloadLib :: DynFlags -> [String] -> LibrarySpec -> IO ()
-        preloadLib dflags lib_paths lib_spec
-           = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
-                case lib_spec of
-                   Object static_ish
-                      -> do b <- preload_static lib_paths static_ish
-                            maybePutStrLn dflags (if b  then "done." 
-                                                       else "not found")
-                   DLL dll_unadorned
-                      -> do maybe_errstr <- loadDynamic lib_paths dll_unadorned
-                            case maybe_errstr of
-                               Nothing -> return ()
-                               Just mm -> preloadFailed mm lib_paths lib_spec
-                            maybePutStrLn dflags "done"
-
-        preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
-        preloadFailed sys_errmsg paths spec
-           = do maybePutStr dflags
-                      ("failed.\nDynamic linker error message was:\n   " 
-                        ++ sys_errmsg  ++ "\nWhilst trying to load:  " 
-                        ++ showLS spec ++ "\nDirectories to search are:\n"
-                        ++ unlines (map ("   "++) paths) )
-                give_up
-
-        -- not interested in the paths in the static case.
-        preload_static paths name
-           = do b <- doesFileExist name
-                if not b then return False
-                         else loadObj name >> return True
-
-        give_up 
-           = (throwDyn . CmdLineError)
-                "user specified .o/.so/.DLL could not be loaded."
-\end{code}
-
-
 %************************************************************************
 %*                                                                     *
 \subsection{The byte-code linker}
@@ -555,8 +645,7 @@ unload_wkr dflags linkables pls
        objs_loaded' <- filterM (maybeUnload objs_to_keep) (objs_loaded pls)
         bcos_loaded' <- filterM (maybeUnload bcos_to_keep) (bcos_loaded pls)
 
-               let objs_retained = map linkableModName objs_loaded'
-           bcos_retained = map linkableModName bcos_loaded'
+               let bcos_retained = map linkableModule bcos_loaded'
            itbl_env'     = filterNameMap bcos_retained (itbl_env pls)
             closure_env'  = filterNameMap bcos_retained (closure_env pls)
            new_pls = pls { itbl_env = itbl_env',
@@ -600,9 +689,11 @@ data LibrarySpec
                        --          On WinDoze  "burble"  denotes "burble.DLL"
                        --  loadDLL is platform-specific and adds the lib/.so/.DLL
                        --  suffixes platform-dependently
-#ifdef darwin_TARGET_OS
-   | Framework String
-#endif
+
+   | DLLPath FilePath   -- Absolute or relative pathname to a dynamic library
+                       -- (ends with .dll or .so).
+
+   | Framework String  -- Only used for darwin, but does no harm
 
 -- If this package is already part of the GHCi binary, we'll already
 -- have the right DLLs for this package loaded, so don't try to
@@ -613,20 +704,19 @@ data LibrarySpec
 -- of DLL handles that rts/Linker.c maintains, and that in turn is 
 -- used by lookupSymbol.  So we must call addDLL for each library 
 -- just to get the DLL handle into the list.
-partOfGHCi 
-#          ifndef mingw32_TARGET_OS
-           = [ "base", "haskell98", "haskell-src", "readline" ]
+partOfGHCi
+#          if defined(mingw32_TARGET_OS) || defined(darwin_TARGET_OS)
+           = [ ]
 #          else
-          = [ ]
+           = [ "base", "haskell98", "template-haskell", "readline" ]
 #          endif
 
-showLS (Object nm)  = "(static) " ++ nm
-showLS (DLL nm) = "(dynamic) " ++ nm
-#ifdef darwin_TARGET_OS
+showLS (Object nm)    = "(static) " ++ nm
+showLS (DLL nm)       = "(dynamic) " ++ nm
+showLS (DLLPath nm)   = "(dynamic) " ++ nm
 showLS (Framework nm) = "(framework) " ++ nm
-#endif
 
-linkPackages :: DynFlags -> [PackageName] -> IO ()
+linkPackages :: DynFlags -> [PackageId] -> IO ()
 -- Link exactly the specified packages, and their dependents
 -- (unless of course they are already linked)
 -- The dependents are linked automatically, and it doesn't matter
@@ -641,14 +731,14 @@ linkPackages :: DynFlags -> [PackageName] -> IO ()
 
 linkPackages dflags new_pkgs
    = do        { pls     <- readIORef v_PersistentLinkerState
-       ; pkg_map <- getPackageConfigMap
+       ; let pkg_map = pkgIdMap (pkgState dflags)
 
        ; pkgs' <- link pkg_map (pkgs_loaded pls) new_pkgs
 
        ; writeIORef v_PersistentLinkerState (pls { pkgs_loaded = pkgs' })
        }
    where
-     link :: PackageConfigMap -> [PackageName] -> [PackageName] -> IO [PackageName]
+     link :: PackageConfigMap -> [PackageId] -> [PackageId] -> IO [PackageId]
      link pkg_map pkgs new_pkgs 
        = foldM (link_one pkg_map) pkgs new_pkgs
 
@@ -656,65 +746,73 @@ linkPackages dflags new_pkgs
        | new_pkg `elem` pkgs   -- Already linked
        = return pkgs
 
-       | Just pkg_cfg <- lookupPkg pkg_map new_pkg
+       | Just pkg_cfg <- lookupPackage pkg_map new_pkg
        = do {  -- Link dependents first
-              pkgs' <- link pkg_map pkgs (packageDependents pkg_cfg)
+              pkgs' <- link pkg_map pkgs (map mkPackageId (depends pkg_cfg))
                -- Now link the package itself
             ; linkPackage dflags pkg_cfg
             ; return (new_pkg : pkgs') }
 
        | otherwise
-       = throwDyn (CmdLineError ("unknown package name: " ++ packageNameString new_pkg))
+       = throwDyn (CmdLineError ("unknown package: " ++ packageIdString new_pkg))
 
 
 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
-#ifdef darwin_TARGET_OS
-        let fwDirs    =  Packages.framework_dirs pkg
-        let frameworks=  Packages.extra_frameworks pkg
-#endif
 
         -- 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
-#ifdef darwin_TARGET_OS
-           loadFrameworks fwDirs frameworks
-#endif
-           loadDynamics dirs dlls
+       when (pkgName (package pkg) `notElem` partOfGHCi) $ do
+           loadFrameworks pkg
+            -- 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 ++ "'")
-
-loadDynamics dirs [] = return ()
-loadDynamics dirs (dll:dlls) = do
-  r <- loadDynamic dirs dll
-  case r of
-    Nothing  -> loadDynamics dirs dlls
-    Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: " 
-                                       ++ dll ++ " (" ++ err ++ ")" ))
-#ifdef darwin_TARGET_OS
-loadFrameworks dirs [] = return ()
-loadFrameworks dirs (fw:fws) = do
-  r <- loadFramework dirs fw
-  case r of
-    Nothing  -> loadFrameworks dirs fws
-    Just err -> throwDyn (CmdLineError ("can't load framework: " 
-                                       ++ fw ++ " (" ++ err ++ ")" ))
+             else throwDyn (InstallationError ("unable to load package `" ++ showPackageId (package pkg) ++ "'"))
+
+load_dyn dirs dll = do r <- loadDynamic dirs dll
+                      case r of
+                        Nothing  -> return ()
+                        Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: " 
+                                                             ++ dll ++ " (" ++ err ++ ")" ))
+#ifndef darwin_TARGET_OS
+loadFrameworks pkg = return ()
+#else
+loadFrameworks pkg = mapM_ load frameworks
+  where
+    fw_dirs    = Packages.frameworkDirs pkg
+    frameworks = Packages.extraFrameworks pkg
+
+    load fw = do  r <- loadFramework fw_dirs fw
+                 case r of
+                   Nothing  -> return ()
+                   Just err -> throwDyn (CmdLineError ("can't load framework: " 
+                                                               ++ fw ++ " (" ++ err ++ ")" ))
 #endif
 
 -- Try to find an object file for a given library in the given paths.
@@ -724,9 +822,14 @@ locateOneObj dirs lib
   = do { mb_obj_path <- findFile mk_obj_path dirs 
        ; case mb_obj_path of
            Just obj_path -> return (Object obj_path)
-           Nothing       -> return (DLL lib) } -- we assume
+           Nothing       -> 
+                do { mb_lib_path <- findFile mk_dyn_lib_path dirs
+                   ; case mb_lib_path of
+                       Just lib_path -> return (DLL (lib ++ "_dyn"))
+                       Nothing       -> return (DLL lib) }}            -- We assume
    where
      mk_obj_path dir = dir ++ '/':lib ++ ".o"
+     mk_dyn_lib_path dir = dir ++ '/':mkSOName (lib ++ "_dyn")
 
 
 -- ----------------------------------------------------------------------------