llvm-tf 3.1 → 3.1.0.1

raw patch · 2 files changed

+38/−12 lines, 2 files

Files

• llvm-tf.cabal +2/−2
• src/LLVM/Core/CodeGenMonad.hs +36/−10

@@ -1,5 +1,5 @@ Name:          llvm-tf-Version:       3.1+Version:       3.1.0.1 License:       BSD3 License-File:  LICENSE Synopsis:      Bindings to the LLVM compiler toolkit using type families.@@ -39,7 +39,7 @@   Location: http://code.haskell.org/~thielema/llvm-tf/  Source-Repository this-  Tag:      3.1+  Tag:      3.1.0.1   Type:     darcs   Location: http://code.haskell.org/~thielema/llvm-tf/ 

@@ -9,15 +9,17 @@     CodeGenFunction, runCodeGenFunction, liftCodeGenModule, genFSym, getFunction, getBuilder, getFunctionModule, getExterns, putExterns,     ) where -import LLVM.Core.Util (Module, Builder, Function)+import LLVM.Core.Util (Module, Builder, Function, getValueNameU, withModule, )  import qualified LLVM.FFI.Core as FFI import qualified LLVM.FFI.ExecutionEngine as EE -import Foreign.Ptr (FunPtr, Ptr, )+import Foreign.C.String (withCString, )+import Foreign.Ptr (FunPtr, Ptr, nullPtr, )  import Control.Monad.Trans.State (StateT, runStateT, evalStateT, get, gets, put, modify, ) import Control.Monad.IO.Class (MonadIO, liftIO, )+import Control.Monad (when, ) import Control.Applicative (Applicative, ) import Data.Monoid (Monoid, mempty, mappend, (<>), ) @@ -95,17 +97,41 @@  addGlobalMapping ::     Value -> Ptr a -> CodeGenModule ()-addGlobalMapping value func = CGM $ modify $ \cgm ->-    cgm { cgm_global_mappings =-             cgm_global_mappings cgm <>-             GlobalMappings (\ee -> EE.addGlobalMapping ee value func) }+addGlobalMapping value func =+    CGM $ addMappingToState $+        GlobalMappings (\ee -> EE.addGlobalMapping ee value func)  addFunctionMapping ::     Function -> FunPtr f -> CodeGenModule ()-addFunctionMapping value func = CGM $ modify $ \cgm ->-    cgm { cgm_global_mappings =-             cgm_global_mappings cgm <>-             GlobalMappings (\ee -> EE.addFunctionMapping ee value func) }+addFunctionMapping value func = CGM $ do+    {-+    We need to fetch the name from the value+    since it might have been disambiguized after adding.+    -}+    name <- liftIO $ getValueNameU value+    modul <- gets cgm_module+    addMappingToState $+        GlobalMappings $ \ee -> do+            {-+            Between adding and application+            the program may have been restructured by optimization passes.+            I have not seen that the optimizer alters a Function Value pointer,+            but the optimizer can remove an unused function.+            That would render the original value invalid.+            -}+            currentValue <-+                liftIO $+                    withCString name $ \cname ->+                    withModule modul $ \cmodule ->+                        FFI.getNamedFunction cmodule cname+            -- the optimizer could have removed the function+            when (currentValue/=nullPtr) $+                EE.addFunctionMapping ee currentValue func++addMappingToState :: GlobalMappings -> StateT CGMState IO ()+addMappingToState gm =+    modify $ \cgm ->+        cgm { cgm_global_mappings = cgm_global_mappings cgm <> gm }  newtype GlobalMappings =     GlobalMappings (EE.ExecutionEngineRef -> IO ())