diff --git a/LLVM/Core.hs b/LLVM/Core.hs --- a/LLVM/Core.hs +++ b/LLVM/Core.hs @@ -52,7 +52,7 @@ -- * Code generation CodeGenFunction, CodeGenModule, -- * Functions - Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction, + Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction, setFuncCallConv, TFunction, -- * Global variable creation Global, newGlobal, newNamedGlobal, defineGlobal, createGlobal, createNamedGlobal, diff --git a/LLVM/Core/CodeGen.hs b/LLVM/Core/CodeGen.hs --- a/LLVM/Core/CodeGen.hs +++ b/LLVM/Core/CodeGen.hs @@ -7,7 +7,7 @@ Linkage(..), Visibility(..), -- * Function creation - Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction, + Function, newFunction, newNamedFunction, defineFunction, createFunction, createNamedFunction, setFuncCallConv, addAttributes, FFI.Attribute(..), externFunction, staticFunction, @@ -230,6 +230,15 @@ f <- newNamedFunction linkage name defineFunction f body return f + +-- | Set the calling convention of a function. By default it is the +-- C calling convention. +setFuncCallConv :: Function a + -> FFI.CallingConvention + -> CodeGenModule () +setFuncCallConv (Value f) cc = do + liftIO $ FFI.setFunctionCallConv f (FFI.fromCallingConvention cc) + return () -- | Add attributes to a value. Beware, what attributes are allowed depends on -- what kind of value it is. diff --git a/LLVM/Core/Instructions.hs b/LLVM/Core/Instructions.hs --- a/LLVM/Core/Instructions.hs +++ b/LLVM/Core/Instructions.hs @@ -5,7 +5,7 @@ condBr, br, switch, - invoke, + invoke, invokeWithConv, unwind, unreachable, -- * Arithmetic binary operations @@ -45,7 +45,8 @@ select, -- * Other phi, addPhiInputs, - call, + call, callWithConv, + -- * Classes and types Terminate, Ret, CallArgs, ABinOp, CmpOp, FunctionArgs, FunctionRet, IsConst, @@ -521,6 +522,30 @@ -> g invoke (BasicBlock norm) (BasicBlock expt) (Value f) = doCall (U.makeInvoke norm expt f) [] (undefined :: f) + +-- | Call a function with the given arguments. The 'call' instruction +-- is variadic, i.e., the number of arguments it takes depends on the +-- type of /f/. +-- This also sets the calling convention of the call to the function. +-- As LLVM itself defines, if the calling conventions of the calling +-- /instruction/ and the function being /called/ are different, undefined +-- behavior results. +callWithConv :: (CallArgs f g) => FFI.CallingConvention -> Function f -> g +callWithConv cc (Value f) = doCall (U.makeCallWithCc cc f) [] (undefined :: f) + +-- | Call a function with exception handling. +-- This also sets the calling convention of the call to the function. +-- As LLVM itself defines, if the calling conventions of the calling +-- /instruction/ and the function being /called/ are different, undefined +-- behavior results. +invokeWithConv :: (CallArgs f g) + => FFI.CallingConvention -- ^Calling convention + -> BasicBlock -- ^Normal return point. + -> BasicBlock -- ^Exception return point. + -> Function f -- ^Function to call. + -> g +invokeWithConv cc (BasicBlock norm) (BasicBlock expt) (Value f) = + doCall (U.makeInvokeWithCc cc norm expt f) [] (undefined :: f) -------------------------------------- diff --git a/LLVM/Core/Util.hs b/LLVM/Core/Util.hs --- a/LLVM/Core/Util.hs +++ b/LLVM/Core/Util.hs @@ -23,6 +23,7 @@ constString, constStringNul, constVector, constArray, constStruct, -- * Instructions makeCall, makeInvoke, + makeCallWithCc, makeInvokeWithCc, -- * Misc CString, withArrayLen, withEmptyCString, @@ -286,7 +287,10 @@ type Value = FFI.ValueRef makeCall :: Function -> FFI.BuilderRef -> [Value] -> IO Value -makeCall func bldPtr args = do +makeCall = makeCallWithCc FFI.C + +makeCallWithCc :: FFI.CallingConvention -> Function -> FFI.BuilderRef -> [Value] -> IO Value +makeCallWithCc cc func bldPtr args = do {- print "makeCall" FFI.dumpValue func @@ -294,16 +298,24 @@ print "----------------------" -} withArrayLen args $ \ argLen argPtr -> - withEmptyCString $ - FFI.buildCall bldPtr func argPtr - (fromIntegral argLen) + withEmptyCString $ \cstr -> do + i <- FFI.buildCall bldPtr func argPtr + (fromIntegral argLen) cstr + FFI.setInstructionCallConv i (FFI.fromCallingConvention cc) + return i makeInvoke :: BasicBlock -> BasicBlock -> Function -> FFI.BuilderRef -> [Value] -> IO Value -makeInvoke norm expt func bldPtr args = +makeInvoke = makeInvokeWithCc FFI.C + +makeInvokeWithCc :: FFI.CallingConvention -> BasicBlock -> BasicBlock -> Function -> FFI.BuilderRef -> + [Value] -> IO Value +makeInvokeWithCc cc norm expt func bldPtr args = withArrayLen args $ \ argLen argPtr -> - withEmptyCString $ - FFI.buildInvoke bldPtr func argPtr (fromIntegral argLen) norm expt + withEmptyCString $ \cstr -> do + i <- FFI.buildInvoke bldPtr func argPtr (fromIntegral argLen) norm expt cstr + FFI.setInstructionCallConv i (FFI.fromCallingConvention cc) + return i -------------------------------------- diff --git a/LLVM/FFI/Core.hsc b/LLVM/FFI/Core.hsc --- a/LLVM/FFI/Core.hsc +++ b/LLVM/FFI/Core.hsc @@ -739,6 +739,7 @@ | Cold | X86StdCall | X86FastCall + | GHC deriving (Show, Eq, Ord, Enum, Bounded, Typeable) fromCallingConvention :: CallingConvention -> CUInt @@ -747,6 +748,7 @@ fromCallingConvention Cold = (#const LLVMColdCallConv) fromCallingConvention X86StdCall = (#const LLVMX86FastcallCallConv) fromCallingConvention X86FastCall = (#const LLVMX86StdcallCallConv) +fromCallingConvention GHC = 10 toCallingConvention :: CUInt -> CallingConvention toCallingConvention c | c == (#const LLVMCCallConv) = C @@ -754,6 +756,7 @@ toCallingConvention c | c == (#const LLVMColdCallConv) = Cold toCallingConvention c | c == (#const LLVMX86StdcallCallConv) = X86StdCall toCallingConvention c | c == (#const LLVMX86FastcallCallConv) = X86FastCall +toCallingConvention c | c == 10 = GHC toCallingConvention c = error $ "LLVM.Core.FFI.toCallingConvention: " ++ "unsupported calling convention" ++ show c diff --git a/examples/Makefile b/examples/Makefile --- a/examples/Makefile +++ b/examples/Makefile @@ -1,7 +1,7 @@ ghc := ghc ghcflags := -Wall -optl -w # -DHAS_GETPOINTERTOGLOBAL=1 -examples := HelloJIT Fibonacci BrainF Vector Array DotProd Arith Align Struct Varargs List +examples := HelloJIT Fibonacci BrainF Vector Array DotProd Arith Align Struct Varargs List CallConv all: $(examples:%=%.exe) diff --git a/llvm.cabal b/llvm.cabal --- a/llvm.cabal +++ b/llvm.cabal @@ -1,9 +1,11 @@ name: llvm -version: 0.8.1.0 +version: 0.8.2.0 license: BSD3 license-file: LICENSE synopsis: Bindings to the LLVM compiler toolkit. description: Bindings to the LLVM compiler toolkit. + * New in 0.8.2.0: Support for GHC calling convention. + . * New in 0.8.1.0: Numerous small changes. . * New in 0.8.0.0: Adapted to LLVM 2.7;