Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Try to get this package working again. #9

Merged
merged 2 commits into from
Mar 18, 2019
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions plugins.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -59,6 +59,7 @@ library
filepath,
random,
process,
split,
ghc >= 6.10,
ghc-prim

Expand Down
2 changes: 1 addition & 1 deletion src/System/Plugins/Consts.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@

module System.Plugins.Consts where

#include "../../../config.h"
#include "config.h"


#if __GLASGOW_HASKELL__ >= 604
Expand Down
53 changes: 43 additions & 10 deletions src/System/Plugins/Env.hs
Original file line number Diff line number Diff line change
Expand Up @@ -40,17 +40,19 @@ module System.Plugins.Env (
lookupMerged,
addMerge,
addPkgConf,
defaultPkgConf,
union,
addStaticPkg,
isStaticPkg,
rmStaticPkg,
grabDefaultPkgConf,
readPackageConf,
lookupPkg
lookupPkg,
pkgManglingPrefix

) where

#include "../../../config.h"
#include "config.h"

import System.Plugins.LoadTypes (Module)
import System.Plugins.Consts ( sysPkgSuffix )
Expand All @@ -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 )
Expand All @@ -76,13 +78,14 @@ 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)
Module,
#endif
depends, packageName, PackageName(..)
, installedUnitId
#if MIN_VERSION_ghc(7,10,0)
, installedPackageId
#endif
Expand All @@ -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
--
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -459,14 +485,15 @@ 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.
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)
Expand Down Expand Up @@ -530,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
Expand Down
28 changes: 21 additions & 7 deletions src/System/Plugins/Load.hs
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ module System.Plugins.Load (

) where

#include "../../../config.h"
#include "config.h"

import System.Plugins.Make ( build )
import System.Plugins.Env
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -473,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)
Expand Down Expand Up @@ -595,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)))
Expand All @@ -617,6 +630,7 @@ loadShared str = do
--
loadPackage :: String -> IO ()
loadPackage p = do
initLinker
#if DEBUG
putStr (' ':p) >> hFlush stdout
#endif
Expand Down
2 changes: 1 addition & 1 deletion src/System/Plugins/Parser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ module System.Plugins.Parser (
replaceModName
) where

#include "../../../config.h"
#include "config.h"

import Data.List
import Data.Char
Expand Down
7 changes: 2 additions & 5 deletions src/System/Plugins/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 )
Expand Down Expand Up @@ -289,7 +289,7 @@ findFile (ext:exts) file
infixr 6 </>
infixr 6 <.>

(</>), (<.>), (<+>), (<>) :: FilePath -> FilePath -> FilePath
(</>), (<.>), (<+>) :: FilePath -> FilePath -> FilePath
[] </> b = b
a </> b = a ++ "/" ++ b

Expand All @@ -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 "."
Expand Down