2020-07-22 11:06:47 -04:00
|
|
|
|
{-# LANGUAGE MagicHash #-}
|
|
|
|
|
|
{-# LANGUAGE UnboxedTuples #-}
|
|
|
|
|
|
|
2020-07-22 11:02:18 -04:00
|
|
|
|
module IRC.Plugins.Loader where
|
|
|
|
|
|
|
2020-07-22 11:06:47 -04:00
|
|
|
|
import GHC.Exts ( addrToAny# )
|
|
|
|
|
|
import GHC.Ptr ( Ptr(..) )
|
|
|
|
|
|
import System.Info ( os, arch )
|
|
|
|
|
|
import GHCi.ObjLink
|
|
|
|
|
|
import Encoding
|
|
|
|
|
|
|
|
|
|
|
|
load :: IO (Either String (IO ()))
|
|
|
|
|
|
load = do initObjLinker RetainCAFs
|
|
|
|
|
|
loadObj "Plugin.o"
|
|
|
|
|
|
_ret <- resolveObjs
|
|
|
|
|
|
ptr <- lookupSymbol (mangleSymbol Nothing "Plugin" "f")
|
|
|
|
|
|
case ptr of
|
|
|
|
|
|
Nothing -> return $ Left "Couldn’t load symbol"
|
|
|
|
|
|
Just (Ptr addr) -> case addrToAny# addr of
|
|
|
|
|
|
(# f #) -> return $ Right f
|
|
|
|
|
|
|
|
|
|
|
|
mangleSymbol :: Maybe String -> String -> String -> String
|
|
|
|
|
|
mangleSymbol pkg module' valsym =
|
|
|
|
|
|
prefixUnderscore <>
|
|
|
|
|
|
maybe "" (\p -> zEncodeString p <> "_") pkg <>
|
|
|
|
|
|
zEncodeString module' <> "_" <> zEncodeString valsym <> "_closure"
|
|
|
|
|
|
|
|
|
|
|
|
prefixUnderscore :: String
|
|
|
|
|
|
prefixUnderscore =
|
|
|
|
|
|
case (os,arch) of
|
|
|
|
|
|
("mingw32","x86_64") -> ""
|
|
|
|
|
|
("cygwin","x86_64") -> ""
|
|
|
|
|
|
("mingw32",_) -> "_"
|
|
|
|
|
|
("darwin",_) -> "_"
|
|
|
|
|
|
("cygwin",_) -> "_"
|
|
|
|
|
|
_ -> ""
|
