From 2443774403902ed72d21296bd9fed010843ecc4e Mon Sep 17 00:00:00 2001 From: Galen Huntington Date: Fri, 15 Mar 2019 21:10:40 -0700 Subject: [PATCH 1/2] Get this to compile. --- src/System/Plugins/Consts.hs | 2 +- src/System/Plugins/Env.hs | 7 ++++--- src/System/Plugins/Load.hs | 7 ++++--- src/System/Plugins/Parser.hs | 2 +- src/System/Plugins/Utils.hs | 7 ++----- 5 files changed, 12 insertions(+), 13 deletions(-) diff --git a/src/System/Plugins/Consts.hs b/src/System/Plugins/Consts.hs index 5142fae..2fea08c 100644 --- a/src/System/Plugins/Consts.hs +++ b/src/System/Plugins/Consts.hs @@ -20,7 +20,7 @@ module System.Plugins.Consts where -#include "../../../config.h" +#include "config.h" #if __GLASGOW_HASKELL__ >= 604 diff --git a/src/System/Plugins/Env.hs b/src/System/Plugins/Env.hs index 1826f7f..0a24c64 100644 --- a/src/System/Plugins/Env.hs +++ b/src/System/Plugins/Env.hs @@ -50,7 +50,7 @@ module System.Plugins.Env ( ) where -#include "../../../config.h" +#include "config.h" import System.Plugins.LoadTypes (Module) import System.Plugins.Consts ( sysPkgSuffix ) @@ -76,7 +76,7 @@ import DynFlags ( Way(WayDyn), dynamicGhc, ways, #endif defaultDynFlags, initDynFlags) -import SysTools (initSysTools) +import SysTools (initSysTools, initLlvmConfig) import Distribution.Package hiding ( #if MIN_VERSION_ghc(7,6,0) @@ -466,7 +466,8 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p -- If we're loading dynamic libs we need the cbits to appear before the -- real packages. settings <- initSysTools (Just libdir) - dflags <- initDynFlags $ defaultDynFlags settings + llvmConfig <- initLlvmConfig (Just libdir) + dflags <- initDynFlags $ defaultDynFlags settings llvmConfig libs <- mapM (findHSlib #if MIN_VERSION_ghc(7,8,0) (WayDyn `elem` ways dflags || dynamicGhc) diff --git a/src/System/Plugins/Load.hs b/src/System/Plugins/Load.hs index bff1b21..32a5a08 100644 --- a/src/System/Plugins/Load.hs +++ b/src/System/Plugins/Load.hs @@ -61,7 +61,7 @@ module System.Plugins.Load ( ) where -#include "../../../config.h" +#include "config.h" import System.Plugins.Make ( build ) import System.Plugins.Env @@ -104,7 +104,7 @@ import GHC ( defaultCallbacks ) #else import DynFlags (defaultDynFlags, initDynFlags) import GHC.Paths (libdir) -import SysTools (initSysTools) +import SysTools (initSysTools, initLlvmConfig) #endif import GHC.Ptr ( Ptr(..), nullPtr ) #if !MIN_VERSION_ghc(7,4,1) @@ -127,7 +127,8 @@ readBinIface' hi_path = do -- kludgy as hell #if MIN_VERSION_ghc(7,2,0) mySettings <- initSysTools (Just libdir) -- how should we really set the top dir? - dflags <- initDynFlags (defaultDynFlags mySettings) + llvmConfig <- initLlvmConfig (Just libdir) + dflags <- initDynFlags (defaultDynFlags mySettings llvmConfig) e <- newHscEnv dflags #else e <- newHscEnv defaultCallbacks undefined diff --git a/src/System/Plugins/Parser.hs b/src/System/Plugins/Parser.hs index 9970359..739249a 100644 --- a/src/System/Plugins/Parser.hs +++ b/src/System/Plugins/Parser.hs @@ -25,7 +25,7 @@ module System.Plugins.Parser ( replaceModName ) where -#include "../../../config.h" +#include "config.h" import Data.List import Data.Char diff --git a/src/System/Plugins/Utils.hs b/src/System/Plugins/Utils.hs index bec328e..5c7bb4b 100644 --- a/src/System/Plugins/Utils.hs +++ b/src/System/Plugins/Utils.hs @@ -58,7 +58,7 @@ module System.Plugins.Utils ( ) where -#include "../../../config.h" +#include "config.h" import System.Plugins.Env ( isLoaded ) import System.Plugins.Consts ( objSuf, hiSuf, tmpDir ) @@ -289,7 +289,7 @@ findFile (ext:exts) file infixr 6 infixr 6 <.> -(), (<.>), (<+>), (<>) :: FilePath -> FilePath -> FilePath +(), (<.>), (<+>) :: FilePath -> FilePath -> FilePath [] b = b a b = a ++ "/" ++ b @@ -299,9 +299,6 @@ a <.> b = a ++ "." ++ b [] <+> b = b a <+> b = a ++ " " ++ b -[] <> b = b -a <> b = a ++ b - -- -- | dirname : return the directory portion of a file path -- if null, return "." From 57aa1e606a195c0fe7975b8c7817aa5b4afa9ea6 Mon Sep 17 00:00:00 2001 From: Galen Huntington Date: Fri, 15 Mar 2019 21:43:48 -0700 Subject: [PATCH 2/2] Try to integrate @abarbu patches. --- plugins.cabal | 1 + src/System/Plugins/Env.hs | 46 ++++++++++++++++++++++++++++++++------ src/System/Plugins/Load.hs | 21 +++++++++++++---- 3 files changed, 57 insertions(+), 11 deletions(-) diff --git a/plugins.cabal b/plugins.cabal index 5a657d1..9f7f8b5 100644 --- a/plugins.cabal +++ b/plugins.cabal @@ -59,6 +59,7 @@ library filepath, random, process, + split, ghc >= 6.10, ghc-prim diff --git a/src/System/Plugins/Env.hs b/src/System/Plugins/Env.hs index 0a24c64..4285a1a 100644 --- a/src/System/Plugins/Env.hs +++ b/src/System/Plugins/Env.hs @@ -40,13 +40,15 @@ module System.Plugins.Env ( lookupMerged, addMerge, addPkgConf, + defaultPkgConf, union, addStaticPkg, isStaticPkg, rmStaticPkg, grabDefaultPkgConf, readPackageConf, - lookupPkg + lookupPkg, + pkgManglingPrefix ) where @@ -59,7 +61,7 @@ import Control.Monad ( liftM ) import Data.IORef ( writeIORef, readIORef, newIORef, IORef() ) import Data.Maybe ( isJust, isNothing, fromMaybe ) -import Data.List ( (\\), nub, ) +import Data.List ( (\\), nub ) import System.IO.Unsafe ( unsafePerformIO ) import System.Directory ( doesFileExist ) @@ -83,6 +85,7 @@ import Distribution.Package hiding ( Module, #endif depends, packageName, PackageName(..) + , installedUnitId #if MIN_VERSION_ghc(7,10,0) , installedPackageId #endif @@ -96,6 +99,9 @@ import Distribution.Simple.PackageIndex import Distribution.Simple.Program import Distribution.Verbosity +import System.Environment +import Data.List.Split + import qualified Data.Map as M import qualified Data.Set as S -- @@ -305,6 +311,15 @@ addPkgConf f = do ps <- readPackageConf f modifyPkgEnv env $ \ls -> return $ union ls ps +-- | This function is required when running with stack. +defaultPkgConf :: IO () +defaultPkgConf = do + paths <- lookupEnv "GHC_PACKAGE_PATH" + unsetEnv "GHC_PACKAGE_PATH" + case paths of + Nothing -> return () + Just s -> mapM_ addPkgConf $ splitOn ":" s + -- -- | add a new FM for the package.conf to the list of existing ones; if a package occurs multiple -- times, pick the one with the higher version number as the default (e.g., important for base in @@ -407,6 +422,17 @@ lookupPkg pn = go [] pn (f', g') <- liftM unzip $ mapM (go (nub $ seen ++ ps)) (ps \\ seen) return $ (nub $ (concat f') ++ f, if static then [] else nub $ (concat g') ++ g) +-- This is the prefix of mangled symbols that come from this package. +pkgManglingPrefix :: PackageName -> IO (Maybe String) +-- base seems to be mangled differently! +pkgManglingPrefix "base" = return $ Just "base" +pkgManglingPrefix p = withPkgEnvs env $ \fms -> return (go fms p) + where + go [] _ = Nothing + go (fm:fms) q = case lookupFM fm q of + Nothing -> go fms q -- look in other pkgs + Just pkg -> Just $ drop 2 $ getHSLibraryName $ installedUnitId pkg + data LibrarySpec = DLL String -- -lLib | DLLPath FilePath -- -Lpath @@ -459,9 +485,9 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p ldOptsPaths = [ path | Just (DLLPath path) <- ldInput ] dlls = map mkSOName (extras ++ ldOptsLibs) #if defined(CYGWIN) || defined(__MINGW32__) - libdirs = fix_topdir (libraryDirs pkg) ++ ldOptsPaths + libdirs = fix_topdir (libraryDirs pkg) ++ ldOptsPaths ++ fix_topdir (libraryDynDirs pkg) #else - libdirs = libraryDirs pkg ++ ldOptsPaths + libdirs = libraryDirs pkg ++ ldOptsPaths ++ libraryDynDirs pkg #endif -- If we're loading dynamic libs we need the cbits to appear before the -- real packages. @@ -531,9 +557,15 @@ lookupPkg' p = withPkgEnvs env $ \fms -> go fms p -- Solution: look for dynamic libraries only if using -dynamic; otherwise, use static -- and add any other dynamic libraries found. dl <- findHSdlib dirs lib - let rdl = case dl of - Just file -> Right $ Dynamic file - Nothing -> Left lib + rdl <- case dl of + Just file -> return $ Right $ Dynamic file + Nothing -> do + -- TODO Generate this suffix automatically. It's absurd we have to use the preprocessor. + dynamicSuffix <- findHSdlib dirs (lib ++ "-ghc" ++ (reverse $ takeWhile (/= '-') $ reverse GHC_LIB_PATH)) + case dynamicSuffix of + Just file -> return $ Right $ Dynamic file + Nothing -> return $ Left lib + if dynonly then return rdl else do rsl <- findHSslib dirs lib return $ case rsl of diff --git a/src/System/Plugins/Load.hs b/src/System/Plugins/Load.hs index 32a5a08..a824efc 100644 --- a/src/System/Plugins/Load.hs +++ b/src/System/Plugins/Load.hs @@ -474,10 +474,17 @@ loadFunction__ :: Maybe String -> String -> IO (Maybe a) loadFunction__ pkg m valsym - = do let symbol = prefixUnderscore++(maybe "" (\p -> zEncodeString p++"_") pkg) - ++zEncodeString m++"_"++(zEncodeString valsym)++"_closure" + = do let encode = zEncodeString + p <- case pkg of + Just p -> do + prefix <- pkgManglingPrefix p + return $ encode (maybe p id prefix)++"_" + Nothing -> return "" + let symbol = prefixUnderscore++p++encode m++"_"++(encode valsym)++"_closure" + #if DEBUG putStrLn $ "Looking for <<"++symbol++">>" + initLinker #endif ptr@(Ptr addr) <- withCString symbol c_lookupSymbol if (ptr == nullPtr) @@ -596,10 +603,15 @@ unloadObj (Module { path = p, kind = k, key = ky }) = case k of -- Load a .so type object file. -- loadShared :: FilePath -> IO Module -loadShared str = do +loadShared str' = do #if DEBUG - putStrLn $ " shared: " ++ str + putStrLn $ " shared: " ++ str' #endif + let str = case str' of + -- TODO My GHC segfaults because libm.so is a linker script + "libm.so" -> "/lib/x86_64-linux-gnu/libm.so.6" + "libpthread.so" -> "/lib/x86_64-linux-gnu/libpthread.so.0" + x -> x maybe_errmsg <- withCString str $ \dll -> c_addDLL dll if maybe_errmsg == nullPtr then return (Module str (mkModid str) Shared undefined (Package (mkModid str))) @@ -618,6 +630,7 @@ loadShared str = do -- loadPackage :: String -> IO () loadPackage p = do + initLinker #if DEBUG putStr (' ':p) >> hFlush stdout #endif