diff --git a/cbits/support.cpp b/cbits/support.cpp --- a/cbits/support.cpp +++ b/cbits/support.cpp @@ -135,7 +135,11 @@ void LLVMSetHasUnsafeAlgebra(LLVMValueRef Instr, LLVMBool B) { +#if HS_LLVM_VERSION < 600 (unwrap(Instr))->setHasUnsafeAlgebra(B); +#else + (unwrap(Instr))->setFast(B); +#endif } void LLVMSetHasNoNaNs(LLVMValueRef Instr, LLVMBool B) { (unwrap(Instr))->setHasNoNaNs(B); diff --git a/example/JIT.hs b/example/JIT.hs --- a/example/JIT.hs +++ b/example/JIT.hs @@ -26,6 +26,8 @@ import Control.Exception (bracket, bracket_, finally) import Control.Monad (when, void) +import Data.Tuple.HT (mapSnd) + import qualified System.Exit as Exit import Text.Printf (printf) @@ -96,7 +98,12 @@ withCString "" $ Core.buildCall builder roundFunc ps len Core.setInstructionCallConv call $ Core.fromCallingConvention Core.C - Core.addInstrAttribute call 0 0 + context <- Core.getGlobalContext + attrKind <- + CStr.withCStringLen "readnone" $ + uncurry Core.getEnumAttributeKindForName . mapSnd fromIntegral + attr <- Core.createEnumAttribute context attrKind 0 + Core.addCallSiteAttribute call Core.attributeFunctionIndex attr return call else do void $ withCString "" $ Core.buildFAdd builder loaded loaded diff --git a/example/Offset.hs b/example/Offset.hs new file mode 100644 --- /dev/null +++ b/example/Offset.hs @@ -0,0 +1,81 @@ +module Main where + +import qualified LLVM.FFI.ExecutionEngine as EE +import qualified LLVM.FFI.Target as Target +import qualified LLVM.FFI.Core as LLVM +import qualified LLVM.Target.Native as Native + +import qualified Foreign.Marshal.Array as Array +import qualified Foreign.Marshal.Alloc as Alloc +import Foreign.C.String (withCString, peekCString) +import Foreign.C.Types (CUInt, CULLong) +import Foreign.Storable (Storable, peek) +import Foreign.Ptr (Ptr) + +import qualified System.Exit as Exit +import Control.Exception (finally) +import Control.Monad (when) + +import Text.Printf (printf) + + +withArrayLen :: (Storable a) => [a] -> (CUInt -> Ptr a -> IO b) -> IO b +withArrayLen xs act = + Array.withArrayLen xs $ \len ptr -> act (fromIntegral len) ptr + +offset :: IO CULLong +offset = do + Native.initializeNativeTarget + int1Type <- LLVM.int1Type + int8Type <- LLVM.int8Type + int32Type <- LLVM.int32Type + int64Type <- LLVM.int64Type + structType <- + withArrayLen [int1Type, int32Type, int8Type] $ \n ptr -> + LLVM.structType ptr n LLVM.false + nullPtr <- LLVM.constPointerNull structType + zero <- LLVM.constInt int32Type 0 LLVM.false + one <- LLVM.constInt int32Type 1 LLVM.false + putStrLn "getElementPtr" + -- crash + elementPtr <- + withArrayLen [zero,one] $ \n ixsPtr -> + LLVM.constGEP nullPtr ixsPtr n + putStrLn "ptrToInt" + elementOffset <- LLVM.constPtrToInt elementPtr int64Type + LLVM.constIntGetZExtValue elementOffset + +noResult :: IO () -> IO () +noResult = id + +offsetTarget :: IO [CULLong] +offsetTarget = do + Native.initializeNativeTarget + int1Type <- LLVM.int1Type + int8Type <- LLVM.int8Type + int32Type <- LLVM.int32Type + structType <- + withArrayLen [int1Type, int1Type, int32Type, int8Type] $ \n ptr -> + LLVM.structType ptr n LLVM.false + + modul <- withCString "_module" LLVM.moduleCreateWithName + withCString LLVM.hostTriple $ LLVM.setTarget modul + + Alloc.alloca $ \execEngineRef -> do + Alloc.alloca $ \errorMsgRef -> do + err <- + EE.createExecutionEngineForModuleCPU + execEngineRef modul errorMsgRef + when (err/=LLVM.false) $ do + noResult $ + printf "createExecutionEngine: %s\n" + =<< peekCString =<< peek errorMsgRef + Exit.exitFailure + + execEngine <- peek execEngineRef + flip finally (EE.disposeExecutionEngine execEngine) $ do + td <- EE.getExecutionEngineTargetData execEngine + mapM (Target.offsetOfElement td structType) [0..2] + +main :: IO () +main = print =<< offsetTarget diff --git a/llvm-ffi.cabal b/llvm-ffi.cabal --- a/llvm-ffi.cabal +++ b/llvm-ffi.cabal @@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: llvm-ffi -Version: 3.9.1 +Version: 9.0.0 License: BSD-3-Clause License-File: LICENSE Synopsis: FFI bindings to the LLVM compiler toolkit. @@ -17,7 +17,7 @@ to the LLVM installation directories manually. On Ubuntu this would look like this: . - > cabal install --extra-include-dirs=/usr/lib/llvm-3.9/include --extra-lib-dirs=/usr/lib/llvm-3.9/lib llvm-ffi + > cabal install --extra-include-dirs=/usr/lib/llvm-9/include --extra-lib-dirs=/usr/lib/llvm-9/lib llvm-ffi . You can store such paths permanently in a @pkg-config@ file like @llvm.pc@. The optimal way would be if LLVM installations or GNU/Linux distributions @@ -29,12 +29,12 @@ > cabal install -fpkgConfig . We try to stay up to date with LLVM releases. - The current version of this package is compatible with LLVM 3.4-3.9. + The current version of this package is compatible with LLVM 3.9-9. Please understand that the package may or may not work against older LLVM releases. . Warning for inplace builds: - Re-configuring the package using, say -fllvm307, + Re-configuring the package using, say -fllvm600, and re-buildung it might result in corrupt code. You must make sure that the stuff in @cbits@ is re-compiled. Cabal or GHC may forget about that. @@ -44,7 +44,8 @@ Homepage: http://haskell.org/haskellwiki/LLVM Stability: experimental Category: Compilers/Interpreters, Code Generation -Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==8.0.2, GHC==8.2.2 +Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4 +Tested-With: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5 Build-Type: Simple Extra-Source-Files: @@ -72,32 +73,36 @@ Description: use llvm-3.x.pc instead of llvm.pc Default: True -Flag llvm304 - Description: use LLVM-3.4 instead of latest supported LLVM +Flag llvm309 + Description: use LLVM-3.9 instead of latest supported LLVM Default: False -Flag llvm305 - Description: use LLVM-3.5 instead of latest supported LLVM +Flag llvm400 + Description: use LLVM-4.0 instead of latest supported LLVM Default: False -Flag llvm306 - Description: use LLVM-3.6 instead of latest supported LLVM +Flag llvm500 + Description: use LLVM-5.0 instead of latest supported LLVM Default: False -Flag llvm307 - Description: use LLVM-3.7 instead of latest supported LLVM +Flag llvm600 + Description: use LLVM-6.0 instead of latest supported LLVM Default: False -Flag llvm308 - Description: use LLVM-3.8 instead of latest supported LLVM +Flag llvm700 + Description: use LLVM-7.0 instead of latest supported LLVM Default: False +Flag llvm800 + Description: use LLVM-8.0 instead of latest supported LLVM + Default: False + Source-Repository head Type: darcs Location: http://hub.darcs.net/thielema/llvm-ffi/ Source-Repository this - Tag: 3.9.1 + Tag: 9.0.0 Type: darcs Location: http://hub.darcs.net/thielema/llvm-ffi/ @@ -118,6 +123,7 @@ LLVM.FFI.BitReader LLVM.FFI.BitWriter LLVM.FFI.Core + LLVM.FFI.Core.Attribute LLVM.FFI.ExecutionEngine LLVM.FFI.Support.Host LLVM.FFI.Target @@ -129,6 +135,7 @@ Other-modules: LLVM.FFI.Base + LLVM.FFI.Version LLVM.Target.ARM LLVM.Target.CppBackend LLVM.Target.Hexagon @@ -140,76 +147,88 @@ LLVM.Target.X86 LLVM.Target.XCore - If flag(llvm304) + If flag(llvm309) If flag(pkgConfig) If flag(specificPkgConfig) - PkgConfig-Depends: llvm-3.4 + PkgConfig-Depends: llvm-3.9 Else - PkgConfig-Depends: llvm == 3.4.* + PkgConfig-Depends: llvm == 3.9.* Else - Extra-Libraries: LLVM-3.4 - CC-Options: -DHS_LLVM_VERSION=304 - Cxx-Options: -DHS_LLVM_VERSION=304 - CPP-Options: -DHS_LLVM_VERSION=304 + Extra-Libraries: LLVM-3.9 + CC-Options: -DHS_LLVM_VERSION=309 + Cxx-Options: -DHS_LLVM_VERSION=309 + CPP-Options: -DHS_LLVM_VERSION=309 Else - If flag(llvm305) + If flag(llvm400) If flag(pkgConfig) If flag(specificPkgConfig) - PkgConfig-Depends: llvm-3.5 + PkgConfig-Depends: llvm-4.0 Else - PkgConfig-Depends: llvm == 3.5.* + PkgConfig-Depends: llvm == 4.0.* Else - Extra-Libraries: LLVM-3.5 - CC-Options: -DHS_LLVM_VERSION=305 - Cxx-Options: -DHS_LLVM_VERSION=305 - CPP-Options: -DHS_LLVM_VERSION=305 + Extra-Libraries: LLVM-4.0 + CC-Options: -DHS_LLVM_VERSION=400 + Cxx-Options: -DHS_LLVM_VERSION=400 + CPP-Options: -DHS_LLVM_VERSION=400 Else - If flag(llvm306) + If flag(llvm500) If flag(pkgConfig) If flag(specificPkgConfig) - PkgConfig-Depends: llvm-3.6 + PkgConfig-Depends: llvm-5.0 Else - PkgConfig-Depends: llvm == 3.6.* + PkgConfig-Depends: llvm == 5.0.* Else - Extra-Libraries: LLVM-3.6 - CC-Options: -DHS_LLVM_VERSION=306 - Cxx-Options: -DHS_LLVM_VERSION=306 - CPP-Options: -DHS_LLVM_VERSION=306 + Extra-Libraries: LLVM-5.0 + CC-Options: -DHS_LLVM_VERSION=500 + Cxx-Options: -DHS_LLVM_VERSION=500 + CPP-Options: -DHS_LLVM_VERSION=500 Else - If flag(llvm307) + If flag(llvm600) If flag(pkgConfig) If flag(specificPkgConfig) - PkgConfig-Depends: llvm-3.7 + PkgConfig-Depends: llvm-6.0 Else - PkgConfig-Depends: llvm == 3.7.* + PkgConfig-Depends: llvm == 6.0.* Else - Extra-Libraries: LLVM-3.7 - CC-Options: -DHS_LLVM_VERSION=307 - Cxx-Options: -DHS_LLVM_VERSION=307 - CPP-Options: -DHS_LLVM_VERSION=307 + Extra-Libraries: LLVM-6.0 + CC-Options: -DHS_LLVM_VERSION=600 + Cxx-Options: -DHS_LLVM_VERSION=600 + CPP-Options: -DHS_LLVM_VERSION=600 Else - If flag(llvm308) + If flag(llvm700) If flag(pkgConfig) If flag(specificPkgConfig) - PkgConfig-Depends: llvm-3.8 + PkgConfig-Depends: llvm-7 Else - PkgConfig-Depends: llvm == 3.8.* + PkgConfig-Depends: llvm == 7.* Else - Extra-Libraries: LLVM-3.8 - CC-Options: -DHS_LLVM_VERSION=308 - Cxx-Options: -DHS_LLVM_VERSION=308 - CPP-Options: -DHS_LLVM_VERSION=308 + Extra-Libraries: LLVM-7 + CC-Options: -DHS_LLVM_VERSION=700 + Cxx-Options: -DHS_LLVM_VERSION=700 + CPP-Options: -DHS_LLVM_VERSION=700 Else - If flag(pkgConfig) - If flag(specificPkgConfig) - PkgConfig-Depends: llvm-3.9 + If flag(llvm800) + If flag(pkgConfig) + If flag(specificPkgConfig) + PkgConfig-Depends: llvm-8 + Else + PkgConfig-Depends: llvm == 8.* Else - PkgConfig-Depends: llvm == 3.9.* + Extra-Libraries: LLVM-8 + CC-Options: -DHS_LLVM_VERSION=800 + Cxx-Options: -DHS_LLVM_VERSION=800 + CPP-Options: -DHS_LLVM_VERSION=800 Else - Extra-Libraries: LLVM-3.9 - CC-Options: -DHS_LLVM_VERSION=309 - Cxx-Options: -DHS_LLVM_VERSION=309 - CPP-Options: -DHS_LLVM_VERSION=309 + If flag(pkgConfig) + If flag(specificPkgConfig) + PkgConfig-Depends: llvm-9 + Else + PkgConfig-Depends: llvm == 9.* + Else + Extra-Libraries: LLVM-9 + CC-Options: -DHS_LLVM_VERSION=900 + Cxx-Options: -DHS_LLVM_VERSION=900 + CPP-Options: -DHS_LLVM_VERSION=900 CC-Options: -DHAVE_LLVM_SUPPORT_DYNAMICLIBRARY_H=1 CPP-Options: -D__STDC_CONSTANT_MACROS -D__STDC_FORMAT_MACROS @@ -236,3 +255,20 @@ GHC-Options: -Wall Default-Language: Haskell2010 Main-Is: JIT.hs + +Executable llvm-ffi-offset + If flag(buildExamples) + Build-Depends: + llvm-ffi, + utility-ht >=0.0.9 && <0.1, + base + Else + Buildable: False + + If flag(developer) + GHC-Options: -Werror + + Hs-Source-Dirs: example + GHC-Options: -Wall + Default-Language: Haskell2010 + Main-Is: Offset.hs diff --git a/src/LLVM/FFI/Core.hsc b/src/LLVM/FFI/Core.hsc --- a/src/LLVM/FFI/Core.hsc +++ b/src/LLVM/FFI/Core.hsc @@ -17,6 +17,7 @@ module LLVM.FFI.Core ( initializeCore + , Version.version -- * Boolean values , LLVM.Bool(LLVM.Bool) @@ -89,14 +90,14 @@ , floatTypeInContext , doubleTypeInContext , x86FP80TypeInContext - , fP128TypeInContext - , pPCFP128TypeInContext + , fp128TypeInContext + , ppcFP128TypeInContext , floatType , doubleType , x86FP80Type - , fP128Type - , pPCFP128Type + , fp128Type + , ppcFP128Type -- ** Function types , functionType @@ -319,9 +320,8 @@ , addAlias -- * Parameter passing - , Attribute(..) - , fromAttribute - , toAttribute + , Attribute + , AttributeKind(..) -- ** Calling conventions , CallingConvention(..) @@ -341,9 +341,34 @@ , setFunctionCallConv , getGC , setGC - , addFunctionAttr - , getFunctionAttr - , removeFunctionAttr + , AttributeIndex(AttributeIndex) + , attributeReturnIndex, attributeFunctionIndex + , getEnumAttributeKindForName + , getLastEnumAttributeKind + , createEnumAttribute + , getEnumAttributeKind + , getEnumAttributeValue + , createStringAttribute + , getStringAttributeKind + , getStringAttributeValue + , isEnumAttribute + , isStringAttribute + , addAttributeAtIndex + , getAttributeCountAtIndex + , getAttributesAtIndex + , getEnumAttributeAtIndex + , getStringAttributeAtIndex + , removeEnumAttributeAtIndex + , removeStringAttributeAtIndex + , addTargetDependentFunctionAttr + , addCallSiteAttribute + , getCallSiteAttributeCount + , getCallSiteAttributes + , getCallSiteEnumAttribute + , getCallSiteStringAttribute + , removeCallSiteEnumAttribute + , removeCallSiteStringAttribute + , getCalledValue -- ** Parameters , countParams @@ -354,9 +379,6 @@ , getLastParam , getNextParam , getPreviousParam - , addAttribute - , removeAttribute - , getAttribute , setParamAlignment -- ** Basic blocks @@ -365,6 +387,7 @@ , basicBlockAsValue , valueIsBasicBlock , valueAsBasicBlock + , getBasicBlockName , getBasicBlockParent , getBasicBlockTerminator , countBasicBlocks @@ -396,8 +419,6 @@ -- ** Call Sites , getInstructionCallConv , setInstructionCallConv - , addInstrAttribute - , removeInstrAttribute , setInstrParamAlignment -- ** Call Instructions (only) @@ -568,6 +589,7 @@ ) where +import qualified LLVM.FFI.Version as Version import qualified LLVM.FFI.Base as LLVM import qualified Foreign.C.Types as C @@ -576,9 +598,11 @@ import Data.Typeable (Typeable) +import Data.Word (Word32, Word64) + import Prelude (IO, Eq, Ord, Int, Bounded, Enum, Show, Read, String, - ($), (++), (.), (==), error, + ($), (++), (.), error, fmap, fromIntegral, show, toEnum, ) @@ -601,7 +625,8 @@ deriving (Typeable) type TypeRef = Ptr Type -type BasicBlock = Value +data BasicBlock + deriving (Typeable) type BasicBlockRef = Ptr BasicBlock data Value @@ -632,7 +657,17 @@ deriving (Typeable) type ContextRef = Ptr Context +data Attribute + deriving (Typeable) +type AttributeRef = Ptr Attribute +newtype AttributeIndex = AttributeIndex (#type LLVMAttributeIndex) + +attributeReturnIndex, attributeFunctionIndex :: AttributeIndex +attributeReturnIndex = AttributeIndex (#const LLVMAttributeReturnIndex) +attributeFunctionIndex = AttributeIndex (#const LLVMAttributeFunctionIndex) + + defaultTargetTriple, hostTriple :: String defaultTargetTriple = (#const_str LLVM_DEFAULT_TARGET_TRIPLE) hostTriple = (#const_str LLVM_HOST_TRIPLE) @@ -775,80 +810,6 @@ (#const LLVMProtectedVisibility) -> ProtectedVisibility _ -> error "toVisibility: bad value" -data Attribute - = ZExtAttribute - | SExtAttribute - | NoReturnAttribute - | InRegAttribute - | StructRetAttribute - | NoUnwindAttribute - | NoAliasAttribute - | ByValAttribute - | NestAttribute - | ReadNoneAttribute - | ReadOnlyAttribute - | NoInlineAttribute - | AlwaysInlineAttribute - | OptimizeForSizeAttribute - | StackProtectAttribute - | StackProtectReqAttribute - | NoCaptureAttribute - | NoRedZoneAttribute - | NoImplicitFloatAttribute - | NakedAttribute - deriving (Show, Eq, Ord, Enum, Bounded, Typeable) - -fromAttribute :: Attribute -> CAttribute -fromAttribute c = - case c of - ZExtAttribute -> (#const LLVMZExtAttribute) - SExtAttribute -> (#const LLVMSExtAttribute) - NoReturnAttribute -> (#const LLVMNoReturnAttribute) - InRegAttribute -> (#const LLVMInRegAttribute) - StructRetAttribute -> (#const LLVMStructRetAttribute) - NoUnwindAttribute -> (#const LLVMNoUnwindAttribute) - NoAliasAttribute -> (#const LLVMNoAliasAttribute) - ByValAttribute -> (#const LLVMByValAttribute) - NestAttribute -> (#const LLVMNestAttribute) - ReadNoneAttribute -> (#const LLVMReadNoneAttribute) - ReadOnlyAttribute -> (#const LLVMReadOnlyAttribute) - NoInlineAttribute -> (#const LLVMNoInlineAttribute) - AlwaysInlineAttribute -> (#const LLVMAlwaysInlineAttribute) - OptimizeForSizeAttribute -> (#const LLVMOptimizeForSizeAttribute) - StackProtectAttribute -> (#const LLVMStackProtectAttribute) - StackProtectReqAttribute -> (#const LLVMStackProtectReqAttribute) - NoCaptureAttribute -> (#const LLVMNoCaptureAttribute) - NoRedZoneAttribute -> (#const LLVMNoRedZoneAttribute) - NoImplicitFloatAttribute -> (#const LLVMNoImplicitFloatAttribute) - NakedAttribute -> (#const LLVMNakedAttribute) - -toAttribute :: CAttribute -> Attribute -toAttribute c = - case c of - (#const LLVMZExtAttribute) -> ZExtAttribute - (#const LLVMSExtAttribute) -> SExtAttribute - (#const LLVMNoReturnAttribute) -> NoReturnAttribute - (#const LLVMInRegAttribute) -> InRegAttribute - (#const LLVMStructRetAttribute) -> StructRetAttribute - (#const LLVMNoUnwindAttribute) -> NoUnwindAttribute - (#const LLVMNoAliasAttribute) -> NoAliasAttribute - (#const LLVMByValAttribute) -> ByValAttribute - (#const LLVMNestAttribute) -> NestAttribute - (#const LLVMReadNoneAttribute) -> ReadNoneAttribute - (#const LLVMReadOnlyAttribute) -> ReadOnlyAttribute - (#const LLVMNoInlineAttribute) -> NoInlineAttribute - (#const LLVMAlwaysInlineAttribute) -> AlwaysInlineAttribute - (#const LLVMOptimizeForSizeAttribute) -> OptimizeForSizeAttribute - (#const LLVMStackProtectAttribute) -> StackProtectAttribute - (#const LLVMStackProtectReqAttribute) -> StackProtectReqAttribute - (#const LLVMNoCaptureAttribute) -> NoCaptureAttribute - (#const LLVMNoRedZoneAttribute) -> NoRedZoneAttribute - (#const LLVMNoImplicitFloatAttribute) -> NoImplicitFloatAttribute - (#const LLVMNakedAttribute) -> NakedAttribute - _ -> error "toAttribute: bad value" - -type CAttribute = CInt - -- ** Initialization foreign import ccall unsafe "LLVMInitializeCore" initializeCore :: PassRegistryRef -> IO () @@ -869,7 +830,40 @@ foreign import ccall unsafe "LLVMGetMDKindID" getMDKindID :: CString -> CUInt -> IO CUInt +-- ** Attributes +newtype AttributeKind = AttributeKind CUInt + +foreign import ccall unsafe "LLVMGetEnumAttributeKindForName" getEnumAttributeKindForName + :: CString -> C.CSize -> IO AttributeKind + +foreign import ccall unsafe "LLVMGetLastEnumAttributeKind" getLastEnumAttributeKind + :: IO AttributeKind + +foreign import ccall unsafe "LLVMCreateEnumAttribute" createEnumAttribute + :: ContextRef -> AttributeKind -> Word64 -> IO AttributeRef + +foreign import ccall unsafe "LLVMGetEnumAttributeKind" getEnumAttributeKind + :: AttributeRef -> IO AttributeKind + +foreign import ccall unsafe "LLVMGetEnumAttributeValue" getEnumAttributeValue + :: AttributeRef -> IO Word64 + +foreign import ccall unsafe "LLVMCreateStringAttribute" createStringAttribute + :: ContextRef -> CString -> CUInt -> CString -> CUInt -> IO AttributeRef + +foreign import ccall unsafe "LLVMGetStringAttributeKind" getStringAttributeKind + :: AttributeRef -> Ptr CUInt -> IO CString + +foreign import ccall unsafe "LLVMGetStringAttributeValue" getStringAttributeValue + :: AttributeRef -> Ptr CUInt -> IO CString + +foreign import ccall unsafe "LLVMIsEnumAttribute" isEnumAttribute + :: AttributeRef -> IO LLVM.Bool + +foreign import ccall unsafe "LLVMIsStringAttribute" isStringAttribute + :: AttributeRef -> IO LLVM.Bool + -- ** Modules foreign import ccall unsafe "LLVMModuleCreateWithName" moduleCreateWithName :: CString -> IO ModuleRef @@ -959,16 +953,16 @@ :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMX86FP80TypeInContext" x86FP80TypeInContext :: ContextRef -> IO TypeRef -foreign import ccall unsafe "LLVMFP128TypeInContext" fP128TypeInContext +foreign import ccall unsafe "LLVMFP128TypeInContext" fp128TypeInContext :: ContextRef -> IO TypeRef -foreign import ccall unsafe "LLVMPPCFP128TypeInContext" pPCFP128TypeInContext +foreign import ccall unsafe "LLVMPPCFP128TypeInContext" ppcFP128TypeInContext :: ContextRef -> IO TypeRef foreign import ccall unsafe "LLVMFloatType" floatType :: IO TypeRef foreign import ccall unsafe "LLVMDoubleType" doubleType :: IO TypeRef foreign import ccall unsafe "LLVMX86FP80Type" x86FP80Type :: IO TypeRef -foreign import ccall unsafe "LLVMFP128Type" fP128Type :: IO TypeRef -foreign import ccall unsafe "LLVMPPCFP128Type" pPCFP128Type :: IO TypeRef +foreign import ccall unsafe "LLVMFP128Type" fp128Type :: IO TypeRef +foreign import ccall unsafe "LLVMPPCFP128Type" ppcFP128Type :: IO TypeRef -- ** Function types -- | Create a function type. @@ -998,7 +992,7 @@ -- ** Struct Type foreign import ccall unsafe "LLVMStructTypeInContext" structTypeInContext - :: ContextRef -> (Ptr TypeRef) -> CUInt -> LLVM.Bool -> IO TypeRef + :: ContextRef -> Ptr TypeRef -> CUInt -> LLVM.Bool -> IO TypeRef foreign import ccall unsafe "LLVMStructType" structType :: Ptr TypeRef -> CUInt -> LLVM.Bool -> IO TypeRef foreign import ccall unsafe "LLVMStructCreateNamed" structCreateNamed @@ -1115,14 +1109,14 @@ foreign import ccall unsafe "LLVMMDString" mDString :: CString -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMMDNodeInContext" mDNodeInContext - :: ContextRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef + :: ContextRef -> Ptr ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMMDNode" mDNode - :: (Ptr ValueRef) -> CUInt -> IO ValueRef + :: Ptr ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMGetMDString" getMDString :: ValueRef -> Ptr CUInt -> IO CString {- foreign import ccall unsafe "LLVMGetMDNodeNumOperands" getMDNodeNumOperands - :: ValueRef -> IO (CInt) + :: ValueRef -> IO CInt foreign import ccall unsafe "LLVMGetMDNodeOperand" getMDNodeOperand :: ValueRef -> CUInt -> IO (Ptr ValueRef) -} @@ -1155,7 +1149,7 @@ foreign import ccall unsafe "LLVMConstStringInContext" constStringInContext :: ContextRef -> CString -> CUInt -> LLVM.Bool -> IO ValueRef foreign import ccall unsafe "LLVMConstStructInContext" constStructInContext - :: ContextRef -> (Ptr ValueRef) -> CUInt -> LLVM.Bool -> IO ValueRef + :: ContextRef -> Ptr ValueRef -> CUInt -> LLVM.Bool -> IO ValueRef foreign import ccall unsafe "LLVMConstString" constString :: CString -> CUInt -> LLVM.Bool -> IO ValueRef foreign import ccall unsafe "LLVMConstArray" constArray @@ -1241,7 +1235,7 @@ foreign import ccall unsafe "LLVMConstGEP" constGEP :: ValueRef -> Ptr ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstInBoundsGEP" constInBoundsGEP - :: ValueRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef + :: ValueRef -> Ptr ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMConstTrunc" constTrunc :: ValueRef -> TypeRef -> IO ValueRef foreign import ccall unsafe "LLVMConstSExt" constSExt @@ -1368,13 +1362,33 @@ :: ValueRef -> IO CString foreign import ccall unsafe "LLVMSetGC" setGC :: ValueRef -> CString -> IO () -foreign import ccall unsafe "LLVMGetFunctionAttr" getFunctionAttr - :: ValueRef -> IO CUInt {-Attribute-} -foreign import ccall unsafe "LLVMAddFunctionAttr" addFunctionAttr - :: ValueRef -> CAttribute -> IO () -foreign import ccall unsafe "LLVMRemoveFunctionAttr" removeFunctionAttr - :: ValueRef -> CAttribute -> IO () +-- ** Attribute attachment + +foreign import ccall unsafe "LLVMAddAttributeAtIndex" addAttributeAtIndex + :: ValueRef -> AttributeIndex -> AttributeRef -> IO () + +foreign import ccall unsafe "LLVMGetAttributeCountAtIndex" getAttributeCountAtIndex + :: ValueRef -> AttributeIndex -> IO CUInt + +foreign import ccall unsafe "LLVMGetAttributesAtIndex" getAttributesAtIndex + :: ValueRef -> AttributeIndex -> Ptr AttributeRef -> IO () + +foreign import ccall unsafe "LLVMGetEnumAttributeAtIndex" getEnumAttributeAtIndex + :: ValueRef -> AttributeIndex -> AttributeKind -> IO AttributeRef + +foreign import ccall unsafe "LLVMGetStringAttributeAtIndex" getStringAttributeAtIndex + :: ValueRef -> AttributeIndex -> CString -> CUInt -> IO AttributeRef + +foreign import ccall unsafe "LLVMRemoveEnumAttributeAtIndex" removeEnumAttributeAtIndex + :: ValueRef -> AttributeIndex -> AttributeKind -> IO () + +foreign import ccall unsafe "LLVMRemoveStringAttributeAtIndex" removeStringAttributeAtIndex + :: ValueRef -> AttributeIndex -> CString -> CUInt -> IO () + +foreign import ccall unsafe "LLVMAddTargetDependentFunctionAttr" addTargetDependentFunctionAttr + :: ValueRef -> CString -> CString -> IO () + -- ** Parameters foreign import ccall unsafe "LLVMCountParams" countParams :: ValueRef -- ^ function @@ -1397,12 +1411,6 @@ :: ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMGetPreviousParam" getPreviousParam :: ValueRef -> IO ValueRef -foreign import ccall unsafe "LLVMAddAttribute" addAttribute - :: ValueRef -> CAttribute -> IO () -foreign import ccall unsafe "LLVMRemoveAttribute" removeAttribute - :: ValueRef -> CAttribute -> IO () -foreign import ccall unsafe "LLVMGetAttribute" getAttribute - :: ValueRef -> IO CUInt{-Attribute-} foreign import ccall unsafe "LLVMSetParamAlignment" setParamAlignment :: ValueRef -> CUInt -> IO () @@ -1414,6 +1422,8 @@ foreign import ccall unsafe "LLVMValueAsBasicBlock" valueAsBasicBlock :: ValueRef -- ^ basic block -> IO BasicBlockRef +foreign import ccall unsafe "LLVMGetBasicBlockName" getBasicBlockName + :: BasicBlockRef -> IO CString foreign import ccall unsafe "LLVMGetBasicBlockParent" getBasicBlockParent :: BasicBlockRef -> IO ValueRef foreign import ccall unsafe "LLVMGetBasicBlockTerminator" getBasicBlockTerminator @@ -1480,13 +1490,33 @@ :: ValueRef -> CUInt -> IO () foreign import ccall unsafe "LLVMGetInstructionCallConv" getInstructionCallConv :: ValueRef -> IO CUInt -foreign import ccall unsafe "LLVMAddInstrAttribute" addInstrAttribute - :: ValueRef -> CUInt -> CAttribute -> IO () -foreign import ccall unsafe "LLVMRemoveInstrAttribute" removeInstrAttribute - :: ValueRef -> CUInt -> CAttribute -> IO () foreign import ccall unsafe "LLVMSetInstrParamAlignment" setInstrParamAlignment :: ValueRef -> CUInt -> CUInt -> IO () +foreign import ccall unsafe "LLVMAddCallSiteAttribute" addCallSiteAttribute + :: ValueRef -> AttributeIndex -> AttributeRef -> IO () + +foreign import ccall unsafe "LLVMGetCallSiteAttributeCount" getCallSiteAttributeCount + :: ValueRef -> AttributeIndex -> IO CUInt + +foreign import ccall unsafe "LLVMGetCallSiteAttributes" getCallSiteAttributes + :: ValueRef -> AttributeIndex -> Ptr AttributeRef -> IO () + +foreign import ccall unsafe "LLVMGetCallSiteEnumAttribute" getCallSiteEnumAttribute + :: ValueRef -> AttributeIndex -> AttributeKind -> IO AttributeRef + +foreign import ccall unsafe "LLVMGetCallSiteStringAttribute" getCallSiteStringAttribute + :: ValueRef -> AttributeIndex -> CString -> CUInt -> IO AttributeRef + +foreign import ccall unsafe "LLVMRemoveCallSiteEnumAttribute" removeCallSiteEnumAttribute + :: ValueRef -> AttributeIndex -> AttributeKind -> IO () + +foreign import ccall unsafe "LLVMRemoveCallSiteStringAttribute" removeCallSiteStringAttribute + :: ValueRef -> AttributeIndex -> CString -> CUInt -> IO () + +foreign import ccall unsafe "LLVMGetCalledValue" getCalledValue + :: ValueRef -> IO ValueRef + -- ** Call instructions foreign import ccall unsafe "LLVMIsTailCall" isTailCall :: ValueRef -> IO LLVM.Bool @@ -1499,7 +1529,7 @@ -- ** Phi Nodes foreign import ccall unsafe "LLVMAddIncoming" addIncoming - :: ValueRef -> Ptr ValueRef -> Ptr ValueRef -> CUInt -> IO () + :: ValueRef -> Ptr ValueRef -> Ptr BasicBlockRef -> CUInt -> IO () foreign import ccall unsafe "LLVMCountIncoming" countIncoming :: ValueRef -> IO CUInt foreign import ccall unsafe "LLVMGetIncomingValue" getIncomingValue @@ -1543,7 +1573,7 @@ foreign import ccall unsafe "LLVMBuildRet" buildRet :: BuilderRef -> ValueRef -> IO ValueRef foreign import ccall unsafe "LLVMBuildAggregateRet" buildAggregateRet - :: BuilderRef -> (Ptr ValueRef) -> CUInt -> IO ValueRef + :: BuilderRef -> Ptr ValueRef -> CUInt -> IO ValueRef foreign import ccall unsafe "LLVMBuildBr" buildBr :: BuilderRef -> BasicBlockRef -> IO ValueRef foreign import ccall unsafe "LLVMBuildCondBr" buildCondBr @@ -1680,7 +1710,7 @@ :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildInBoundsGEP" buildInBoundsGEP - :: BuilderRef -> ValueRef -> (Ptr ValueRef) -> CUInt -> CString -> IO ValueRef + :: BuilderRef -> ValueRef -> Ptr ValueRef -> CUInt -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildStructGEP" buildStructGEP :: BuilderRef -> ValueRef -> CUInt -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildGlobalString" buildGlobalString diff --git a/src/LLVM/FFI/Core/Attribute.hs b/src/LLVM/FFI/Core/Attribute.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/Core/Attribute.hs @@ -0,0 +1,295 @@ +module LLVM.FFI.Core.Attribute ( + Name(Name), + zeroext, + signext, + inreg, + byval, + sret, + align, + noalias, + nocapture, + nest, + returned, + nonnull, + dereferenceable, + dereferenceableOrNull, + swiftself, + swifterror, + immarg, + alignstack, + allocsize, + alwaysinline, + builtin, + cold, + convergent, + inaccessiblememonly, + inaccessiblememOrArgmemonly, + inlinehint, + jumptable, + minsize, + naked, + noJumpTables, + nobuiltin, + noduplicate, + nofree, + noimplicitfloat, + noinline, + nonlazybind, + noredzone, + indirectTlsSegRefs, + noreturn, + norecurse, + willreturn, + nosync, + nounwind, + nullPointerIsValid, + optforfuzzing, + optnone, + optsize, + patchableFunction, + probeStack, + readnone, + readonly, + stackProbeSize, + noStackArgProbe, + writeonly, + argmemonly, + returnsTwice, + safestack, + sanitizeAddress, + sanitizeMemory, + sanitizeThread, + sanitizeHwaddress, + sanitizeMemtag, + speculativeLoadHardening, + speculatable, + ssp, + sspreq, + sspstrong, + strictfp, + uwtable, + nocfCheck, + shadowcallstack, + ) where + + +-- data Function +-- data Parameter +newtype Name = Name String + +-- fgrep '