diff --git a/cbits/extra.cpp b/cbits/extra.cpp deleted file mode 100644 --- a/cbits/extra.cpp +++ /dev/null @@ -1,557 +0,0 @@ -/* - * Copyright (c) 2008-10, Mahadevan R All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * * Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * * Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * * Neither the name of this software, nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS - * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT - * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR - * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT - * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT - * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, - * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY - * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT - * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE - * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - */ - -/** - * These are some "extra" functions not available in the standard LLVM-C - * bindings, but are required / good-to-have inorder to implement the - * Python bindings. - */ - -#ifndef __STDC_LIMIT_MACROS -#define __STDC_LIMIT_MACROS -#endif -#ifndef __STDC_CONSTANT_MACROS -#define __STDC_CONSTANT_MACROS -#endif - -// LLVM includes -#include "llvm/IR/LLVMContext.h" -#include "llvm/IR/Module.h" -#include "llvm/IR/IRBuilder.h" -#include "llvm/IR/Constants.h" -#include "llvm/IR/DerivedTypes.h" -#include "llvm/IR/GlobalVariable.h" -#include "llvm/IR/IntrinsicInst.h" -#include "llvm/Bitcode/ReaderWriter.h" -#include "llvm/Support/MemoryBuffer.h" -#include "llvm/Support/Casting.h" -#include "llvm/Support/MemoryBuffer.h" -#include "llvm/IR/CallSite.h" -#include "llvm/IR/Verifier.h" -#include "llvm/AsmParser/Parser.h" -#ifdef HAVE_LLVM_SUPPORT_DYNAMICLIBRARY_H -# include "llvm/Support/DynamicLibrary.h" -#else -# include "llvm/System/DynamicLibrary.h" -#endif -#include "llvm/PassManager.h" -#include "llvm/ExecutionEngine/ExecutionEngine.h" -#include "llvm/Analysis/LoopPass.h" -#include "llvm/Analysis/Passes.h" -#include "llvm/Analysis/DomPrinter.h" -#include "llvm/Transforms/Scalar.h" -#include "llvm/Transforms/IPO.h" -#include "llvm/Transforms/Utils/UnifyFunctionExitNodes.h" -#include "llvm/Transforms/Instrumentation.h" -#include "llvm/Transforms/Utils/Cloning.h" -#include "llvm/Linker/Linker.h" -#include "llvm/Support/SourceMgr.h" -#include "llvm/Support/raw_ostream.h" - -// LLVM-C includes -#include "llvm-c/Core.h" -#include "llvm-c/ExecutionEngine.h" -#include "llvm-c/Target.h" - -// our includes -#include "extra.h" - -//using namespace llvm; - -unsigned LLVMInitNativeTarget() -{ - return LLVMInitializeNativeTarget(); -} - -char *LLVMDumpModuleToString(LLVMModuleRef module) -{ - std::string s; - llvm::raw_string_ostream buf(s); - llvm::Module *p = llvm::unwrap(module); - assert(p); - p->print(buf, NULL); - return strdup(buf.str().c_str()); -} - -char *LLVMDumpTypeToString(LLVMTypeRef type) -{ - std::string s; - llvm::raw_string_ostream buf(s); - llvm::Type *p = llvm::unwrap(type); - assert(p); - p->print(buf); - return strdup(buf.str().c_str()); -} - -char *LLVMDumpValueToString(LLVMValueRef value) -{ - std::string s; - llvm::raw_string_ostream buf(s); - llvm::Value *p = llvm::unwrap(value); - assert(p); - p->print(buf); - return strdup(buf.str().c_str()); -} - -#if HS_LLVM_VERSION < 305 -unsigned LLVMModuleGetPointerSize(LLVMModuleRef module) -{ - llvm::Module *modulep = llvm::unwrap(module); - assert(modulep); - - llvm::Module::PointerSize p = modulep->getPointerSize(); - if (p == llvm::Module::Pointer32) - return 32; - else if (p == llvm::Module::Pointer64) - return 64; - return 0; -} -#endif - -LLVMValueRef LLVMModuleGetOrInsertFunction(LLVMModuleRef module, - const char *name, LLVMTypeRef function_type) -{ - assert(name); - - llvm::Module *modulep = llvm::unwrap(module); - assert(modulep); - - llvm::FunctionType *ftp = llvm::unwrap(function_type); - assert(ftp); - - llvm::Constant *f = modulep->getOrInsertFunction(name, ftp); - return wrap(f); -} - -int LLVMHasInitializer(LLVMValueRef global_var) -{ - llvm::GlobalVariable *gvp = llvm::unwrap(global_var); - assert(gvp); - - return gvp->hasInitializer(); -} - -#define inst_checkfn(ourfn, llvmfn) \ -unsigned ourfn (LLVMValueRef v) { \ - llvm::Instruction *ip = llvm::unwrap(v); \ - assert(ip); \ - return ip-> llvmfn () ? 1 : 0; \ -} - -inst_checkfn(LLVMInstIsTerminator, isTerminator) -inst_checkfn(LLVMInstIsBinaryOp, isBinaryOp) -inst_checkfn(LLVMInstIsShift, isShift) -inst_checkfn(LLVMInstIsCast, isCast) -inst_checkfn(LLVMInstIsLogicalShift, isLogicalShift) -inst_checkfn(LLVMInstIsArithmeticShift, isArithmeticShift) -inst_checkfn(LLVMInstIsAssociative, isAssociative) -inst_checkfn(LLVMInstIsCommutative, isCommutative) - -unsigned LLVMInstIsVolatile(LLVMValueRef v) -{ - using namespace llvm; - Instruction *ip = unwrap(v); - assert(ip); - return ((isa(*ip) && cast(*ip).isVolatile()) || - (isa(*ip) && cast(*ip).isVolatile()) ); -} - -const char *LLVMInstGetOpcodeName(LLVMValueRef inst) -{ - llvm::Instruction *instp = llvm::unwrap(inst); - assert(instp); - return instp->getOpcodeName(); -} - -unsigned LLVMInstGetOpcode(LLVMValueRef inst) -{ - llvm::Instruction *instp = llvm::unwrap(inst); - assert(instp); - return instp->getOpcode(); -} - -unsigned LLVMCmpInstGetPredicate(LLVMValueRef cmpinst) -{ - llvm::CmpInst *instp = llvm::unwrap(cmpinst); - assert(instp); - return instp->getPredicate(); -} - -/* llvm::unwrap a set of `n' wrapped objects starting at `values', - * into a vector of pointers to llvm::unwrapped objects `out'. */ -template -static inline void unwrap_vec(W *values, unsigned n, std::vector& out) -{ - out.clear(); - - while (n--) { - UW *p = llvm::unwrap(*values); - assert(p); - out.push_back(p); - ++values; - } -} - -/* Same as llvm::unwrap_vec, but use a vector of const pointers. */ -template -static inline void unwrap_cvec(W *values, unsigned n, std::vector& out) -{ - out.clear(); - - while (n--) { - UW *p = llvm::unwrap(*values); - assert(p); - out.push_back(p); - ++values; - } -} - -LLVMValueRef LLVMBuildRetMultiple(LLVMBuilderRef builder, - LLVMValueRef *values, unsigned n_values) -{ - assert(values); - - std::vector values_vec; - unwrap_vec(values, n_values, values_vec); - - llvm::IRBuilder<> *builderp = llvm::unwrap(builder); - assert(builderp); - - return llvm::wrap(builderp->CreateAggregateRet(&values_vec[0], values_vec.size())); -} - -LLVMValueRef LLVMBuildGetResult(LLVMBuilderRef builder, - LLVMValueRef value, unsigned index, const char *name) -{ - assert(name); - - llvm::IRBuilder<> *builderp = llvm::unwrap(builder); - assert(builderp); - - return llvm::wrap(builderp->CreateExtractValue(llvm::unwrap(value), index, name)); -} - -unsigned LLVMValueGetID(LLVMValueRef value) -{ - llvm::Value *valuep = llvm::unwrap(value); - assert(valuep); - - return valuep->getValueID(); -} - -unsigned LLVMValueGetNumUses(LLVMValueRef value) -{ - llvm::Value *valuep = llvm::unwrap(value); - assert(valuep); - - return valuep->getNumUses(); -} - -unsigned LLVMValueGetUses(LLVMValueRef value, LLVMValueRef **refs) -{ - llvm::Value *valuep = llvm::unwrap(value); - assert(valuep); - - unsigned n = valuep->getNumUses(); - if (n == 0) - return 0; - - assert(refs); - LLVMValueRef *out = (LLVMValueRef *)malloc(sizeof(LLVMValueRef) * n); - if (!out) - return 0; - *refs = out; - - memset(out, 0, sizeof(LLVMValueRef) * n); - llvm::Value::use_iterator it = valuep->use_begin(); - while (it != valuep->use_end()) { - *out++ = llvm::wrap(*it); - ++it; - } - - return n; -} - -unsigned LLVMValueIsUsedInBasicBlock(LLVMValueRef value, LLVMBasicBlockRef bb) -{ - llvm::Value *valuep = llvm::unwrap(value); - assert(valuep); - llvm::BasicBlock *bbp = llvm::unwrap(bb); - assert(bbp); - return valuep->isUsedInBasicBlock(bbp); -} - -void LLVMDisposeValueRefArray(LLVMValueRef *refs) -{ - assert(refs); - free(refs); -} - -unsigned LLVMUserGetNumOperands(LLVMValueRef user) -{ - llvm::User *userp = llvm::unwrap(user); - assert(userp); - return userp->getNumOperands(); -} - -LLVMValueRef LLVMUserGetOperand(LLVMValueRef user, unsigned idx) -{ - llvm::User *userp = llvm::unwrap(user); - assert(userp); - llvm::Value *operand = userp->getOperand(idx); - return llvm::wrap(operand); -} - -unsigned LLVMGetDoesNotThrow(LLVMValueRef fn) -{ - llvm::Function *fnp = llvm::unwrap(fn); - assert(fnp); - - return fnp->doesNotThrow(); -} - -void LLVMSetDoesNotThrow(LLVMValueRef fn) -{ - llvm::Function *fnp = llvm::unwrap(fn); - assert(fnp); - - return fnp->setDoesNotThrow(); -} - -LLVMValueRef LLVMGetIntrinsic(LLVMModuleRef module, int id, - LLVMTypeRef *types, unsigned n_types) -{ - assert(types); - -#if HS_LLVM_VERSION >= 300 - std::vector types_vec; - unwrap_vec(types, n_types, types_vec); -#else - std::vector types_vec; - unwrap_cvec(types, n_types, types_vec); -#endif - - llvm::Module *modulep = llvm::unwrap(module); - assert(modulep); - -#if HS_LLVM_VERSION >= 300 - llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, - llvm::Intrinsic::ID(id), types_vec); -#else - llvm::Function *intfunc = llvm::Intrinsic::getDeclaration(modulep, - llvm::Intrinsic::ID(id), &types_vec[0], types_vec.size()); -#endif - return wrap(intfunc); -} - -LLVMModuleRef LLVMGetModuleFromAssembly(const char *asmtext, unsigned txtlen, - char **out) -{ - assert(asmtext); - assert(out); - - llvm::Module *modulep; - llvm::SMDiagnostic error; - if (!(modulep = llvm::ParseAssemblyString(asmtext, NULL, error, - llvm::getGlobalContext()))) { - std::string s; - llvm::raw_string_ostream buf(s); - // error.Print("llvm-py", buf); - *out = strdup(buf.str().c_str()); - return NULL; - } - - return wrap(modulep); -} - -#if HS_LLVM_VERSION < 305 -LLVMModuleRef LLVMGetModuleFromBitcode(const char *bitcode, unsigned bclen, - char **out) -{ - assert(bitcode); - assert(out); - - llvm::StringRef as_str(bitcode, bclen); - - llvm::MemoryBuffer *mbp; - if (!(mbp = llvm::MemoryBuffer::getMemBufferCopy(as_str))) - return NULL; - - std::string msg; - llvm::Module *modulep; - if (!(modulep = llvm::ParseBitcodeFile(mbp, llvm::getGlobalContext(), - &msg))) - *out = strdup(msg.c_str()); - - delete mbp; - return wrap(modulep); -} -#endif - -unsigned LLVMLinkModules(LLVMModuleRef dest, LLVMModuleRef src, unsigned mode, - char **out) -{ - llvm::Module *sourcep = llvm::unwrap(src); - assert(sourcep); - llvm::Module *destinationp = llvm::unwrap(dest); - assert(destinationp); - - std::string msg; - bool err; - -#if HS_LLVM_VERSION >= 300 - err = llvm::Linker::LinkModules(destinationp, sourcep, mode, &msg); -#else - err = llvm::Linker::LinkModules(destinationp, sourcep, &msg); -#endif - - if (err) { - *out = strdup(msg.c_str()); - return 0; - } - - return 1; -} - -unsigned char *LLVMGetBitcodeFromModule(LLVMModuleRef module, unsigned *lenp) -{ - assert(lenp); - - llvm::Module *modulep = llvm::unwrap(module); - assert(modulep); - - /* get bc into a string */ - std::string s; - llvm::raw_string_ostream buf(s); - llvm::WriteBitcodeToFile(modulep, buf); - const std::string& bc = buf.str(); - - /* and then into a malloc()-ed block */ - size_t bclen = bc.size(); - unsigned char *bytes = (unsigned char *)malloc(bclen); - if (!bytes) - return NULL; - memcpy(bytes, bc.data(), bclen); - - /* return */ - *lenp = bclen; - return bytes; -} - -/* Return 0 on failure (with errmsg filled in), 1 on success. */ -unsigned LLVMLoadLibraryPermanentlyError(const char* filename, char **errmsg) -{ - assert(filename); - assert(errmsg); - - /* Note: the LLVM API returns true on failure. Don't ask why. */ - std::string msg; - if (llvm::sys::DynamicLibrary::LoadLibraryPermanently(filename, &msg)) { - *errmsg = strdup(msg.c_str()); - return 0; - } - - return 1; -} - -void *LLVMGetPointerToFunction(LLVMExecutionEngineRef ee, LLVMValueRef fn) -{ - llvm::ExecutionEngine *eep = llvm::unwrap(ee); - assert(eep); - - llvm::Function *fnp = llvm::unwrap(fn); - assert(fnp); - - return eep->getPointerToFunction(fnp); -} - -int LLVMInlineFunction(LLVMValueRef call) -{ - llvm::Value *callp = llvm::unwrap(call); - assert(callp); - - llvm::CallSite cs = llvm::CallSite(callp); - - llvm::InlineFunctionInfo unused; - return llvm::InlineFunction(cs, unused); -} - - -/* Passes. A few passes (listed below) are used directly from LLVM-C, - * rest are defined here. - */ - -#define define_pass(P) \ -void LLVMAdd ## P ## Pass (LLVMPassManagerRef passmgr) { \ - using namespace llvm; \ - llvm::PassManagerBase *pmp = llvm::unwrap(passmgr); \ - assert(pmp); \ - pmp->add( create ## P ## Pass ()); \ -} - -define_pass( AAEval ) -define_pass( AliasAnalysisCounter ) -define_pass( AlwaysInliner ) -define_pass( BasicAliasAnalysis ) -define_pass( BreakCriticalEdges ) -define_pass( DeadCodeElimination ) -define_pass( DeadInstElimination ) -define_pass( DemoteRegisterToMemory ) -define_pass( DomOnlyPrinter ) -define_pass( DomOnlyViewer ) -define_pass( DomPrinter ) -define_pass( DomViewer ) -define_pass( GlobalsModRef ) -define_pass( InstCount ) -define_pass( InstructionNamer ) -define_pass( LazyValueInfo ) -define_pass( LCSSA ) -define_pass( LoopExtractor ) -define_pass( LoopSimplify ) -define_pass( LowerInvoke ) -define_pass( LowerSwitch ) -define_pass( MergeFunctions ) -define_pass( NoAA ) -define_pass( PartialInlining ) -define_pass( PostDomOnlyPrinter ) -define_pass( PostDomOnlyViewer ) -define_pass( PostDomPrinter ) -define_pass( PostDomViewer ) -define_pass( ScalarEvolutionAliasAnalysis ) -define_pass( SingleLoopExtractor ) -define_pass( StripNonDebugSymbols ) -define_pass( UnifyFunctionExitNodes ) - -/* we support only internalize(true) */ -llvm::ModulePass *createInternalize2Pass() { - return llvm::createInternalizePass(); -} -define_pass( Internalize2 ) - diff --git a/cbits/support.cpp b/cbits/support.cpp --- a/cbits/support.cpp +++ b/cbits/support.cpp @@ -6,14 +6,53 @@ #endif #include "llvm-c/Core.h" +#include "llvm-c/Target.h" #include "llvm/PassManager.h" #include "llvm/Transforms/IPO/PassManagerBuilder.h" #include "llvm/Transforms/IPO.h" +#include "llvm-c/ExecutionEngine.h" +#include "llvm/ExecutionEngine/ExecutionEngine.h" +#include "llvm/IR/IRBuilder.h" +#include "llvm/IR/Module.h" +#include "llvm/IR/Operator.h" +#include "llvm/Support/Host.h" + #include "support.h" using namespace llvm; + +unsigned LLVMInitNativeTarget() +{ + LLVMBool init = LLVMInitializeNativeTarget(); + LLVMInitializeNativeAsmParser(); + LLVMInitializeNativeAsmPrinter(); + return init; +} + +unsigned LLVMInstGetOpcode(LLVMValueRef inst) +{ + llvm::Instruction *instp = llvm::unwrap(inst); + assert(instp); + return instp->getOpcode(); +} + +unsigned LLVMCmpInstGetPredicate(LLVMValueRef cmpinst) +{ + llvm::CmpInst *instp = llvm::unwrap(cmpinst); + assert(instp); + return instp->getPredicate(); +} + +unsigned LLVMValueGetNumUses(LLVMValueRef value) +{ + llvm::Value *valuep = llvm::unwrap(value); + assert(valuep); + return valuep->getNumUses(); +} + + void LLVMCreateStandardFunctionPasses(LLVMPassManagerRef PM, unsigned OptimizationLevel) { @@ -53,8 +92,6 @@ Builder.DisableSimplifyLibCalls = !SimplifyLibCalls; #endif Builder.DisableUnitAtATime = !UnitAtATime; - - Pass *InliningPass = 0; if (DisableInline) { // No inlining pass @@ -86,4 +123,107 @@ UnitAtATime, UnrollLoops, SimplifyLibCalls, HaveExceptions, InliningPass); #endif +} + +const char *LLVMGetHostCPUName(size_t &len) { + StringRef r = sys::getHostCPUName(); + len = r.size(); + return r.data(); +} + + + +/* +getHostCPUFeatures supports X86 only starting with LLVM-3.7 +How does llc -mattr=help work? It seems to emit directly to stderr. +*/ +LLVMFeatureMapRef LLVMGetHostFeatures() { + LLVMFeatureMapRef features = new(LLVMFeatureMap); + if (sys::getHostCPUFeatures(*features)) { + return features; + } else { + delete features; + return nullptr; + } +} + +void LLVMFreeFeatures(LLVMFeatureMapRef features) { + delete(features); +} + +LLVMFeatureIteratorRef LLVMCheckFeature + (LLVMFeatureMapRef features, LLVMFeatureIteratorRef featureRef) { + if (*featureRef == features->end()) { + delete featureRef; + return nullptr; + } else { + return featureRef; + } +} + +LLVMFeatureIteratorRef LLVMGetFirstFeature(LLVMFeatureMapRef features) { + return LLVMCheckFeature(features, new LLVMFeatureIterator(features->begin())); +} + +LLVMFeatureIteratorRef LLVMGetNextFeature + (LLVMFeatureMapRef features, LLVMFeatureIteratorRef featureRef) { + (*featureRef)++; + return LLVMCheckFeature(features, featureRef); +} + +const char *LLVMGetFeatureName(LLVMFeatureIteratorRef featureRef) { + return (*featureRef)->first().data(); +} + +LLVMBool LLVMGetFeatureSupport(LLVMFeatureIteratorRef featureRef) { + return (*featureRef)->second; +} + + + +LLVMBool LLVMCreateExecutionEngineForModuleCPU + (LLVMExecutionEngineRef *OutEE, + LLVMModuleRef M, + char **OutError) { + std::string Error; +#if HS_LLVM_VERSION < 306 + EngineBuilder builder(unwrap(M)); +#else + EngineBuilder builder(std::unique_ptr(unwrap(M))); +#endif + builder.setEngineKind(EngineKind::Either) + .setMCPU(sys::getHostCPUName().data()) + .setErrorStr(&Error); + if (ExecutionEngine *EE = builder.create()){ + *OutEE = wrap(EE); + return 0; + } + *OutError = strdup(Error.c_str()); + return 1; +} + + +void LLVMSetHasUnsafeAlgebra(LLVMValueRef Instr, LLVMBool B) { + (unwrap(Instr))->setHasUnsafeAlgebra(B); +} +void LLVMSetHasNoNaNs(LLVMValueRef Instr, LLVMBool B) { + (unwrap(Instr))->setHasNoNaNs(B); +} +void LLVMSetHasNoInfs(LLVMValueRef Instr, LLVMBool B) { + (unwrap(Instr))->setHasNoInfs(B); +} +void LLVMSetHasNoSignedZeros(LLVMValueRef Instr, LLVMBool B) { + (unwrap(Instr))->setHasNoSignedZeros(B); +} +void LLVMSetHasAllowReciprocal(LLVMValueRef Instr, LLVMBool B) { + (unwrap(Instr))->setHasAllowReciprocal(B); +} +void LLVMSetFastMathFlags(LLVMValueRef Instr, unsigned Flags) { + FastMathFlags FMF; + if (Flags & FastMathFlags::NoNaNs) FMF.setNoNaNs(); + if (Flags & FastMathFlags::NoInfs) FMF.setNoInfs(); + if (Flags & FastMathFlags::NoSignedZeros) FMF.setNoSignedZeros(); + if (Flags & FastMathFlags::AllowReciprocal) FMF.setAllowReciprocal(); + if (Flags & FastMathFlags::UnsafeAlgebra) FMF.setUnsafeAlgebra(); + (unwrap(Instr))->setFastMathFlags(FMF); } diff --git a/example/JIT.hs b/example/JIT.hs new file mode 100644 --- /dev/null +++ b/example/JIT.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +{- | +This program has two purposes: +First a minimalistic demonstration of how to generate and run code with LLVM. +Second a test program that forces to run the linker. +It let us check whether Haskell bindings match C functions. +-} +module Main where + +import qualified LLVM.FFI.Transforms.PassManagerBuilder as PMB +import qualified LLVM.FFI.Transforms.Scalar as Transform +import qualified LLVM.FFI.ExecutionEngine as EE +import qualified LLVM.FFI.BitWriter as BW +import qualified LLVM.FFI.Core as Core +import qualified LLVM.Target.Native as Native + +import qualified Foreign.C.String as CStr +import qualified Foreign.Marshal.Array as Array +import qualified Foreign.Marshal.Alloc as Alloc +import Foreign.C.String (withCString) +import Foreign.C.Types (CUInt, CFloat) +import Foreign.Storable (Storable, peek, sizeOf) +import Foreign.Ptr (Ptr, FunPtr) + +import Control.Exception (bracket, bracket_, finally) +import Control.Monad (when, void) + +import qualified System.Exit as Exit +import Text.Printf (printf) + + +vectorSize :: Int +roundName :: String + +(vectorSize, roundName) = + if False + then (4, "llvm.x86.sse41.round.ps") + else (8, "llvm.x86.avx.round.ps.256") + +withArrayLen :: (Storable a) => [a] -> (CUInt -> Ptr a -> IO b) -> IO b +withArrayLen xs act = + Array.withArrayLen xs $ \len ptr -> act (fromIntegral len) ptr + +noResult :: IO () -> IO () +noResult = id + +type Importer f = FunPtr f -> f + +foreign import ccall safe "dynamic" derefFuncPtr :: Importer (Ptr a -> IO ()) + + + +main :: IO () +main = do + Native.initializeNativeTarget + + modul <- withCString "_module" Core.moduleCreateWithName + withCString Core.hostTriple $ Core.setTarget modul + vectorType <- + if True + then Core.floatType >>= flip Core.vectorType (fromIntegral vectorSize) + else Core.floatType + + ptrType <- Core.pointerType vectorType 0 + voidType <- Core.voidType + let params = [ptrType] + let false = 0 + roundType <- + withArrayLen params $ \len ps -> + Core.functionType voidType ps len false + func <- withCString "round" $ \name -> Core.addFunction modul name roundType + Core.setLinkage func $ Core.fromLinkage Core.ExternalLinkage + builder <- Core.createBuilder + block <- withCString "_L1" $ Core.appendBasicBlock func + Core.positionAtEnd builder block + param <- Core.getParam func 0 + loaded <- withCString "" $ Core.buildLoad builder param + int32Type <- Core.int32Type + let funcParams = [vectorType, int32Type] + funcType <- + withArrayLen funcParams $ \len ps -> + Core.functionType vectorType ps len false + roundFunc <- + withCString roundName $ \name -> Core.addFunction modul name funcType + Core.setLinkage roundFunc $ Core.fromLinkage Core.ExternalLinkage + callRound <- + if True + then do + const1 <- Core.constInt int32Type 1 false + let callParams = [loaded, const1] + call <- + withArrayLen callParams $ \len ps -> + withCString "" $ Core.buildCall builder roundFunc ps len + Core.setInstructionCallConv call $ + Core.fromCallingConvention Core.C + Core.addInstrAttribute call 0 0 + return call + else do + void $ withCString "" $ Core.buildFAdd builder loaded loaded + zero <- Core.constNull vectorType + add <- withCString "" $ Core.buildFAdd builder loaded zero + let true = 1 + Core.setHasNoSignedZeros add true + return add + + void $ Core.buildStore builder callRound param + void $ Core.buildRetVoid builder + + void $ withCString "round-avx.bc" $ BW.writeBitcodeToFile modul + + when True $ + bracket Core.createPassManager Core.disposePassManager $ \mpasses -> + bracket (Core.createFunctionPassManagerForModule modul) + Core.disposePassManager $ \fpasses -> do + Transform.addVerifierPass mpasses + + bracket PMB.create PMB.dispose $ \passBuilder -> do + PMB.setOptLevel passBuilder 3 + PMB.populateFunctionPassManager passBuilder fpasses + PMB.populateModulePassManager passBuilder mpasses + + bracket_ + (Core.initializeFunctionPassManager fpasses) + (Core.finalizeFunctionPassManager fpasses) + (void $ Core.runFunctionPassManager fpasses func) + void $ Core.runPassManager mpasses modul + + void $ withCString "round-avx-opt.bc" $ BW.writeBitcodeToFile modul + + Alloc.alloca $ \execEngineRef -> do + Alloc.alloca $ \errorMsgRef -> do + err <- + EE.createExecutionEngineForModuleCPU execEngineRef modul errorMsgRef + when err $ do + noResult $ + printf "Core.createExecutionEngine: %s\n" + =<< CStr.peekCString =<< peek errorMsgRef + Exit.exitFailure + + execEngine <- peek execEngineRef + flip finally (EE.disposeExecutionEngine execEngine) $ do + let vector = take vectorSize $ iterate (1+) (-1.3 :: CFloat) + funcPtr <- EE.getPointerToGlobal execEngine func + let size = sum $ map sizeOf vector + Alloc.allocaBytesAligned size size $ \ptr -> do + Array.pokeArray ptr vector + derefFuncPtr funcPtr ptr + print =<< Array.peekArray vectorSize ptr diff --git a/include/extra.h b/include/extra.h deleted file mode 100644 --- a/include/extra.h +++ /dev/null @@ -1,253 +0,0 @@ -/* - * Copyright (c) 2008-10, Mahadevan R All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * * Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * - * * Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * * Neither the name of this software, nor the names of its - * contributors may be used to endorse or promote products derived from - * this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS - * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT - * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR - * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT - * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT - * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, - * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY - * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT - * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE - * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - */ - -/** - * These are some "extra" functions not available in the standard LLVM-C - * bindings, but are required / good-to-have inorder to implement the - * Python bindings. - */ - -#ifndef LLVM_PY_EXTRA_H -#define LLVM_PY_EXTRA_H - -#ifdef __cplusplus -extern "C" { -#endif - -/* Notes: - * - Some returned strings must be disposed of by LLVMDisposeMessage. These are - * indicated in the comments. Where it is not indicated, DO NOT call dispose. - */ - - -/* Wraps the LLVMInitializeTarget macro from Target.h */ -unsigned LLVMInitNativeTarget(void); - - -/* Wraps llvm::Module::print(). Dispose the returned string after use, via - * LLVMDisposeMessage(). */ -char *LLVMDumpModuleToString(LLVMModuleRef module); - -/* Wraps llvm::Type::print(). Dispose the returned string after use, via - * LLVMDisposeMessage(). */ -char *LLVMDumpTypeToString(LLVMTypeRef type); - -/* Wraps llvm::Value::print(). Dispose the returned string after use, via - * LLVMDisposeMessage(). */ -char *LLVMDumpValueToString(LLVMValueRef Val); - -/* Wraps llvm::IRBuilder::CreateRet(). */ -LLVMValueRef LLVMBuildRetMultiple(LLVMBuilderRef bulder, LLVMValueRef *values, - unsigned n_values); - -/* Wraps llvm::IRBuilder::CreateGetResult(). */ -LLVMValueRef LLVMBuildGetResult(LLVMBuilderRef builder, LLVMValueRef value, - unsigned index, const char *name); - -/* Wraps llvm::Value::getValueID(). */ -unsigned LLVMValueGetID(LLVMValueRef value); - -/* Wraps llvm::Value::getNumUses(). */ -unsigned LLVMValueGetNumUses(LLVMValueRef value); - -/* Wraps llvm::Value::use_{begin,end}. Allocates LLVMValueRef's as - * required. Number of objects are returned as return value. If that is - * greater than zero, the pointer given out must be freed by a - * subsequent call to LLVMDisposeValueRefArray(). */ -unsigned LLVMValueGetUses(LLVMValueRef value, LLVMValueRef **refs); - -/* Wraps llvm::Value::isUsedInBasicBlock(). */ -unsigned LLVMValueIsUsedInBasicBlock(LLVMValueRef value, LLVMBasicBlockRef bb); -/* See above. */ -void LLVMDisposeValueRefArray(LLVMValueRef *refs); - -/* Wraps llvm:User::getNumOperands(). */ -unsigned LLVMUserGetNumOperands(LLVMValueRef user); - -/* Wraps llvm:User::getOperand(). */ -LLVMValueRef LLVMUserGetOperand(LLVMValueRef user, unsigned idx); - -/* Wraps llvm::ConstantExpr::getVICmp(). */ -LLVMValueRef LLVMConstVICmp(LLVMIntPredicate predicate, LLVMValueRef lhs, - LLVMValueRef rhs); - -/* Wraps llvm::ConstantExpr::getVFCmp(). */ -LLVMValueRef LLVMConstVFCmp(LLVMRealPredicate predicate, LLVMValueRef lhs, - LLVMValueRef rhs); - -/* Wraps llvm::IRBuilder::CreateVICmp(). */ -LLVMValueRef LLVMBuildVICmp(LLVMBuilderRef builder, LLVMIntPredicate predicate, - LLVMValueRef lhs, LLVMValueRef rhs, const char *name); - -/* Wraps llvm::IRBuilder::CreateVFCmp(). */ -LLVMValueRef LLVMBuildVFCmp(LLVMBuilderRef builder, LLVMRealPredicate predicate, - LLVMValueRef lhs, LLVMValueRef rhs, const char *name); - -/* Wraps llvm::Intrinsic::getDeclaration(). */ -LLVMValueRef LLVMGetIntrinsic(LLVMModuleRef builder, int id, - LLVMTypeRef *types, unsigned n_types); - -/* Wraps llvm::Function::doesNotThrow(). */ -unsigned LLVMGetDoesNotThrow(LLVMValueRef fn); - -/* Wraps llvm::Function::setDoesNotThrow(). */ -void LLVMSetDoesNotThrow(LLVMValueRef fn, int DoesNotThrow); - -/* Wraps llvm::Module::getPointerSize(). */ -unsigned LLVMModuleGetPointerSize(LLVMModuleRef module); - -/* Wraps llvm::Module::getOrInsertFunction(). */ -LLVMValueRef LLVMModuleGetOrInsertFunction(LLVMModuleRef module, - const char *name, LLVMTypeRef function_type); - -/* Wraps llvm::GlobalVariable::hasInitializer(). */ -int LLVMHasInitializer(LLVMValueRef global_var); - -/* The following functions wrap various llvm::Instruction::isXXX() functions. - * All of them take an instruction and return 0 (isXXX returned false) or 1 - * (isXXX returned false). */ -unsigned LLVMInstIsTerminator (LLVMValueRef inst); -unsigned LLVMInstIsBinaryOp (LLVMValueRef inst); -unsigned LLVMInstIsShift (LLVMValueRef inst); -unsigned LLVMInstIsCast (LLVMValueRef inst); -unsigned LLVMInstIsLogicalShift (LLVMValueRef inst); -unsigned LLVMInstIsArithmeticShift (LLVMValueRef inst); -unsigned LLVMInstIsAssociative (LLVMValueRef inst); -unsigned LLVMInstIsCommutative (LLVMValueRef inst); -unsigned LLVMInstIsTrapping (LLVMValueRef inst); - -/* As above, but these are wrap methods from subclasses of Instruction. */ -unsigned LLVMInstIsVolatile (LLVMValueRef inst); - -/* Wraps llvm::Instruction::getOpcodeName(). */ -const char *LLVMInstGetOpcodeName(LLVMValueRef inst); - -/* Wraps llvm::Instruction::getOpcode(). */ -unsigned LLVMInstGetOpcode(LLVMValueRef inst); - -/* Wraps llvm::CmpInst::getPredicate(). */ -unsigned LLVMCmpInstGetPredicate(LLVMValueRef cmpinst); - -/* Wraps llvm::ParseAssemblyString(). Returns a module reference or NULL (with - * `out' pointing to an error message). Dispose error message after use, via - * LLVMDisposeMessage(). */ -LLVMModuleRef LLVMGetModuleFromAssembly(const char *asmtxt, unsigned txten, - char **out); - -/* Wraps llvm::ParseBitcodeFile(). Returns a module reference or NULL (with - * `out' pointing to an error message). Dispose error message after use, via - * LLVMDisposeMessage(). */ -LLVMModuleRef LLVMGetModuleFromBitcode(const char *bc, unsigned bclen, - char **out); - -/* Wraps llvm::Linker::LinkModules(). Returns 0 on failure (with errmsg - * filled in) and 1 on success. Dispose error message after use with - * LLVMDisposeMessage(). */ -unsigned LLVMLinkModules(LLVMModuleRef dest, LLVMModuleRef src, - unsigned mode, char **errmsg); - -/* Returns pointer to a heap-allocated block of `*len' bytes containing bit code - * for the given module. NULL on error. */ -unsigned char *LLVMGetBitcodeFromModule(LLVMModuleRef module, unsigned *len); - -/* Wraps llvm::sys::DynamicLibrary::LoadLibraryPermanently(). Returns 0 on - * failure (with errmsg filled in) and 1 on success. Dispose error message after - * use, via LLVMDisposeMessage(). */ -unsigned LLVMLoadLibraryPermanentlyError(const char* filename, char **errmsg); - -/* Wraps llvm::ExecutionEngine::getPointerToFunction(). Returns a pointer - * to the JITted function. */ -void *LLVMGetPointerToFunction(LLVMExecutionEngineRef ee, LLVMValueRef fn); - -/* Wraps llvm::InlineFunction(). Inlines a function. C is the call - * instruction, created by LLVMBuildCall. Even if it fails, the Function - * containing the call is still in a proper state (not changed). */ -int LLVMInlineFunction(LLVMValueRef call); - -/* Passes. Some passes are used directly from LLVM-C, rest are declared - * here. */ - -#define declare_pass(P) \ - void LLVMAdd ## P ## Pass (LLVMPassManagerRef PM); - -declare_pass( AAEval ) -declare_pass( AliasAnalysisCounter ) -declare_pass( AlwaysInliner ) -declare_pass( BasicAliasAnalysis ) -declare_pass( BlockPlacement ) -declare_pass( BreakCriticalEdges ) -declare_pass( CodeGenPrepare ) -declare_pass( DbgInfoPrinter ) -declare_pass( DeadCodeElimination ) -declare_pass( DeadInstElimination ) -declare_pass( DemoteRegisterToMemory ) -declare_pass( DomOnlyPrinter ) -declare_pass( DomOnlyViewer ) -declare_pass( DomPrinter ) -declare_pass( DomViewer ) -declare_pass( EdgeProfiler ) -declare_pass( GlobalsModRef ) -declare_pass( InstCount ) -declare_pass( InstructionNamer ) -declare_pass( LazyValueInfo ) -declare_pass( LCSSA ) -declare_pass( LoopDependenceAnalysis ) -declare_pass( LoopExtractor ) -declare_pass( LoopSimplify ) -declare_pass( LoopStrengthReduce ) -declare_pass( LowerInvoke ) -declare_pass( LowerSwitch ) -declare_pass( MergeFunctions ) -declare_pass( NoAA ) -declare_pass( NoProfileInfo ) -declare_pass( OptimalEdgeProfiler ) -declare_pass( PartialInlining ) -declare_pass( PostDomOnlyPrinter ) -declare_pass( PostDomOnlyViewer ) -declare_pass( PostDomPrinter ) -declare_pass( PostDomViewer ) -declare_pass( ProfileEstimator ) -declare_pass( ProfileLoader ) -declare_pass( ProfileVerifier ) -declare_pass( ScalarEvolutionAliasAnalysis ) -declare_pass( SingleLoopExtractor ) -declare_pass( StripNonDebugSymbols ) -declare_pass( StructRetPromotion ) -declare_pass( TailDuplication ) -declare_pass( UnifyFunctionExitNodes ) - -declare_pass( Internalize2 ) - -#ifdef __cplusplus -} /* extern "C" */ -#endif - -#endif /* LLVM_PY_EXTRA_H */ - diff --git a/include/support.h b/include/support.h --- a/include/support.h +++ b/include/support.h @@ -1,10 +1,31 @@ #ifndef LLVM_HS_SUPPORT_H #define LLVM_HS_SUPPORT_H + #ifdef __cplusplus +typedef llvm::StringMap LLVMFeatureMap; +typedef llvm::StringMap::const_iterator LLVMFeatureIterator; + extern "C" { +#else +typedef int LLVMFeatureMap; +typedef int LLVMFeatureIterator; #endif + +/* Wraps the LLVMInitializeTarget macro from Target.h */ +unsigned LLVMInitNativeTarget(void); + +/* Wraps llvm::Value::getNumUses(). */ +unsigned LLVMValueGetNumUses(LLVMValueRef value); + +/* Wraps llvm::Instruction::getOpcode(). */ +unsigned LLVMInstGetOpcode(LLVMValueRef inst); + +/* Wraps llvm::CmpInst::getPredicate(). */ +unsigned LLVMCmpInstGetPredicate(LLVMValueRef cmpinst); + + void LLVMCreateStandardFunctionPasses(LLVMPassManagerRef PM, unsigned OptimizationLevel); @@ -16,6 +37,38 @@ int SimplifyLibCalls, int HaveExceptions, int DisableInlining); + + +const char *LLVMGetHostCPUName(size_t &len); + + +typedef LLVMFeatureMap *LLVMFeatureMapRef; +typedef LLVMFeatureIterator *LLVMFeatureIteratorRef; + +LLVMFeatureMapRef LLVMGetHostFeatures(); +void LLVMFreeFeatures(LLVMFeatureMapRef features); + +LLVMFeatureIteratorRef LLVMGetFirstFeature(LLVMFeatureMapRef features); +LLVMFeatureIteratorRef LLVMGetNextFeature(LLVMFeatureMapRef features, LLVMFeatureIteratorRef featureRef); + +const char *LLVMGetFeatureName(LLVMFeatureIteratorRef featureRef); +LLVMBool LLVMGetFeatureSupport(LLVMFeatureIteratorRef featureRef); + + + +LLVMBool LLVMCreateExecutionEngineForModuleCPU + (LLVMExecutionEngineRef *OutEE, + LLVMModuleRef M, + char **OutError); + + +void LLVMSetHasUnsafeAlgebra(LLVMValueRef Instr, LLVMBool B); +void LLVMSetHasNoNaNs(LLVMValueRef Instr, LLVMBool B); +void LLVMSetHasNoInfs(LLVMValueRef Instr, LLVMBool B); +void LLVMSetHasNoSignedZeros(LLVMValueRef Instr, LLVMBool B); +void LLVMSetHasAllowReciprocal(LLVMValueRef Instr, LLVMBool B); +void LLVMSetFastMathFlags(LLVMValueRef Instr, unsigned Flags); + #ifdef __cplusplus } /* extern "C" */ diff --git a/llvm-ffi.cabal b/llvm-ffi.cabal --- a/llvm-ffi.cabal +++ b/llvm-ffi.cabal @@ -1,5 +1,5 @@ Name: llvm-ffi -Version: 3.5.0 +Version: 3.5.1 License: BSD3 License-File: LICENSE Synopsis: FFI bindings to the LLVM compiler toolkit. @@ -25,11 +25,10 @@ Stability: experimental Category: Compilers/Interpreters, Code Generation Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==8.0.1 -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.8 Build-Type: Simple Extra-Source-Files: - include/extra.h include/support.h tool/ltrace.config tool/ltrace.readme @@ -39,6 +38,10 @@ Manual: True Default: False +Flag buildExamples + Description: Build example executables + Default: False + Flag buildTools Description: build tools for managing this package Default: False @@ -52,12 +55,13 @@ Location: http://hub.darcs.net/thielema/llvm-ffi/ Source-Repository this - Tag: 3.5.0 + Tag: 3.5.1 Type: darcs Location: http://hub.darcs.net/thielema/llvm-ffi/ Library Build-Depends: + enumset >=0.0.4 && <0.1, base >= 3 && < 5 Hs-Source-Dirs: src @@ -73,9 +77,12 @@ LLVM.FFI.Core LLVM.FFI.ExecutionEngine LLVM.FFI.Support + LLVM.FFI.Support.Host LLVM.FFI.Target LLVM.FFI.Transforms.IPO + LLVM.FFI.Transforms.PassManagerBuilder LLVM.FFI.Transforms.Scalar + LLVM.FFI.Transforms.Vectorize LLVM.Target.Native Other-modules: @@ -99,9 +106,24 @@ CPP-Options: -D__STDC_CONSTANT_MACROS -D__STDC_FORMAT_MACROS -D__STDC_LIMIT_MACROS Include-Dirs: include C-Sources: - cbits/extra.cpp cbits/support.cpp +Executable llvm-ffi-example + 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 + Main-Is: JIT.hs + Executable llvm-diff-ffi If flag(buildTools) Build-Depends: @@ -142,6 +164,7 @@ If flag(buildTools) Build-Depends: bytestring >=0.9 && <0.11, + regex-posix >=0.95 && <0.96, base Else Buildable: False diff --git a/src/LLVM/FFI/Analysis.hs b/src/LLVM/FFI/Analysis.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/Analysis.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} + +module LLVM.FFI.Analysis where + +import LLVM.FFI.Core (ModuleRef, ValueRef) + +import qualified Foreign.C.Types as C +import Foreign.C.String(CString) +import Foreign.Ptr(Ptr) + +type CInt = C.CInt + + +type VerifierFailureAction = CInt + +foreign import ccall unsafe "LLVMVerifyFunction" verifyFunction + :: ValueRef -> VerifierFailureAction -> IO CInt +foreign import ccall unsafe "LLVMVerifyModule" verifyModule + :: ModuleRef -> VerifierFailureAction -> (Ptr CString) -> IO CInt +foreign import ccall unsafe "LLVMViewFunctionCFG" viewFunctionCFG + :: ValueRef -> IO () +foreign import ccall unsafe "LLVMViewFunctionCFGOnly" viewFunctionCFGOnly + :: ValueRef -> IO () diff --git a/src/LLVM/FFI/Analysis.hsc b/src/LLVM/FFI/Analysis.hsc deleted file mode 100644 --- a/src/LLVM/FFI/Analysis.hsc +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE EmptyDataDecls #-} - -module LLVM.FFI.Analysis where - -import LLVM.FFI.Core (ModuleRef, ValueRef) - -import qualified Foreign.C.Types as C -import Foreign.C.String(CString) -import Foreign.Ptr(Ptr) - -type CInt = C.CInt - - -type VerifierFailureAction = CInt - -foreign import ccall unsafe "LLVMVerifyFunction" verifyFunction - :: ValueRef -> VerifierFailureAction -> IO CInt -foreign import ccall unsafe "LLVMVerifyModule" verifyModule - :: ModuleRef -> VerifierFailureAction -> (Ptr CString) -> IO CInt -foreign import ccall unsafe "LLVMViewFunctionCFG" viewFunctionCFG - :: ValueRef -> IO () -foreign import ccall unsafe "LLVMViewFunctionCFGOnly" viewFunctionCFGOnly - :: ValueRef -> IO () diff --git a/src/LLVM/FFI/BitReader.hs b/src/LLVM/FFI/BitReader.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/BitReader.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} + +module LLVM.FFI.BitReader where + +import LLVM.FFI.Core (MemoryBufferRef, ModuleRef, ContextRef, ModuleProviderRef) + +import qualified Foreign.C.Types as C +import Foreign.C.String(CString) +import Foreign.Ptr(Ptr) + +type CInt = C.CInt + + +foreign import ccall unsafe "LLVMGetBitcodeModuleProvider" getBitcodeModuleProvider + :: MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO CInt +foreign import ccall unsafe "LLVMParseBitcode" parseBitcode + :: MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt +foreign import ccall unsafe "LLVMGetBitcodeModuleProviderInContext" getBitcodeModuleProviderInContext + :: ContextRef -> MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO CInt +foreign import ccall unsafe "LLVMParseBitcodeInContext" parseBitcodeInContext + :: ContextRef -> MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt +foreign import ccall unsafe "LLVMGetBitcodeModule" getBitcodeModule + :: MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool +foreign import ccall unsafe "LLVMGetBitcodeModuleInContext" getBitcodeModuleInContext + :: ContextRef -> MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool diff --git a/src/LLVM/FFI/BitReader.hsc b/src/LLVM/FFI/BitReader.hsc deleted file mode 100644 --- a/src/LLVM/FFI/BitReader.hsc +++ /dev/null @@ -1,27 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE EmptyDataDecls #-} - -module LLVM.FFI.BitReader where - -import LLVM.FFI.Core (MemoryBufferRef, ModuleRef, ContextRef, ModuleProviderRef) - -import qualified Foreign.C.Types as C -import Foreign.C.String(CString) -import Foreign.Ptr(Ptr) - -type CInt = C.CInt - - -foreign import ccall unsafe "LLVMGetBitcodeModuleProvider" getBitcodeModuleProvider - :: MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO CInt -foreign import ccall unsafe "LLVMParseBitcode" parseBitcode - :: MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt -foreign import ccall unsafe "LLVMGetBitcodeModuleProviderInContext" getBitcodeModuleProviderInContext - :: ContextRef -> MemoryBufferRef -> (Ptr ModuleProviderRef) -> (Ptr CString) -> IO CInt -foreign import ccall unsafe "LLVMParseBitcodeInContext" parseBitcodeInContext - :: ContextRef -> MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO CInt -foreign import ccall unsafe "LLVMGetBitcodeModule" getBitcodeModule - :: MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool -foreign import ccall unsafe "LLVMGetBitcodeModuleInContext" getBitcodeModuleInContext - :: ContextRef -> MemoryBufferRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool diff --git a/src/LLVM/FFI/BitWriter.hs b/src/LLVM/FFI/BitWriter.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/BitWriter.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} + +module LLVM.FFI.BitWriter where + +import LLVM.FFI.Core (ModuleRef) + +import qualified Foreign.C.Types as C +import Foreign.C.String(CString) + +type CInt = C.CInt + + +foreign import ccall unsafe "LLVMWriteBitcodeToFile" writeBitcodeToFile + :: ModuleRef -> CString -> IO CInt +foreign import ccall unsafe "LLVMWriteBitcodeToFileHandle" writeBitcodeToFileHandle + :: ModuleRef -> CInt -> IO CInt +foreign import ccall unsafe "LLVMWriteBitcodeToFD" writeBitcodeToFD + :: ModuleRef -> CInt -> CInt -> CInt -> IO CInt diff --git a/src/LLVM/FFI/BitWriter.hsc b/src/LLVM/FFI/BitWriter.hsc deleted file mode 100644 --- a/src/LLVM/FFI/BitWriter.hsc +++ /dev/null @@ -1,20 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE EmptyDataDecls #-} - -module LLVM.FFI.BitWriter where - -import LLVM.FFI.Core (ModuleRef) - -import qualified Foreign.C.Types as C -import Foreign.C.String(CString) - -type CInt = C.CInt - - -foreign import ccall unsafe "LLVMWriteBitcodeToFile" writeBitcodeToFile - :: ModuleRef -> CString -> IO CInt -foreign import ccall unsafe "LLVMWriteBitcodeToFileHandle" writeBitcodeToFileHandle - :: ModuleRef -> CInt -> IO CInt -foreign import ccall unsafe "LLVMWriteBitcodeToFD" writeBitcodeToFD - :: ModuleRef -> CInt -> CInt -> CInt -> IO CInt 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 @@ -45,6 +45,9 @@ , getTarget , setTarget + , defaultTargetTriple + , hostTriple + , dumpModule , setModuleInlineAsm @@ -264,6 +267,22 @@ , constInlineAsm , blockAddress + -- ** Floating point attributes + , setHasUnsafeAlgebra + , setHasNoNaNs + , setHasNoInfs + , setHasNoSignedZeros + , setHasAllowReciprocal + + , FastMathFlags(..) + , FastMathFlagSet + , noNaNs + , noInfs + , noSignedZeros + , allowReciprocal + , unsafeAlgebra + , setFastMathFlags + -- ** Support operations and types , Linkage(..) , fromLinkage @@ -284,7 +303,7 @@ , setVisibility , getAlignment , setAlignment - + -- ** Global variables , addGlobal , addGlobalInAddressSpace @@ -559,6 +578,7 @@ import Foreign.C.String (CString) import Foreign.Ptr (Ptr, FunPtr) +import qualified Data.EnumSet as EnumSet import Data.Typeable (Typeable) @@ -569,6 +589,7 @@ type CULLong = C.CULLong +#include #include data Module @@ -614,6 +635,12 @@ deriving (Typeable) type ContextRef = Ptr Context + +defaultTargetTriple, hostTriple :: String +defaultTargetTriple = (#const_str LLVM_DEFAULT_TARGET_TRIPLE) +hostTriple = (#const_str LLVM_HOST_TRIPLE) + + data TypeKind = VoidTypeKind | FloatTypeKind @@ -668,7 +695,7 @@ -- |An enumeration for the kinds of linkage for global values. data Linkage = ExternalLinkage -- ^Externally visible function - | AvailableExternallyLinkage + | AvailableExternallyLinkage | LinkOnceAnyLinkage -- ^Keep one copy of function when linking (inline) | LinkOnceODRLinkage -- ^Same, but only replaced by something equivalent. | LinkOnceODRAutoHideLinkage -- ^Like LinkOnceODR, but possibly hidden. @@ -680,7 +707,7 @@ | DLLImportLinkage -- ^Function to be imported from DLL | DLLExportLinkage -- ^Function to be accessible from DLL | ExternalWeakLinkage -- ^ExternalWeak linkage description - | GhostLinkage -- ^Stand-in functions for streaming fns from BC files + | GhostLinkage -- ^Stand-in functions for streaming fns from BC files | CommonLinkage -- ^Tentative definitions | LinkerPrivateLinkage -- ^Like Private, but linker removes. | LinkerPrivateWeakLinkage -- ^Like LinkerPrivate, but is weak. @@ -711,7 +738,7 @@ toLinkage c = case c of (#const LLVMExternalLinkage) -> ExternalLinkage - (#const LLVMAvailableExternallyLinkage) -> AvailableExternallyLinkage + (#const LLVMAvailableExternallyLinkage) -> AvailableExternallyLinkage (#const LLVMLinkOnceAnyLinkage) -> LinkOnceAnyLinkage (#const LLVMLinkOnceODRLinkage) -> LinkOnceODRLinkage (#const LLVMLinkOnceODRAutoHideLinkage) -> LinkOnceODRAutoHideLinkage @@ -1616,6 +1643,39 @@ :: BuilderRef -> ValueRef -> CString -> IO ValueRef foreign import ccall unsafe "LLVMBuildNot" buildNot :: BuilderRef -> ValueRef -> CString -> IO ValueRef + +-- ** Floating point attributes +foreign import ccall unsafe "LLVMSetHasUnsafeAlgebra" setHasUnsafeAlgebra + :: ValueRef -> CUInt{-Bool-} -> IO () +foreign import ccall unsafe "LLVMSetHasNoNaNs" setHasNoNaNs + :: ValueRef -> CUInt{-Bool-} -> IO () +foreign import ccall unsafe "LLVMSetHasNoInfs" setHasNoInfs + :: ValueRef -> CUInt{-Bool-} -> IO () +foreign import ccall unsafe "LLVMSetHasNoSignedZeros" setHasNoSignedZeros + :: ValueRef -> CUInt{-Bool-} -> IO () +foreign import ccall unsafe "LLVMSetHasAllowReciprocal" setHasAllowReciprocal + :: ValueRef -> CUInt{-Bool-} -> IO () + +data FastMathFlags + = NoNaNs + | NoInfs + | NoSignedZeros + | AllowReciprocal + | UnsafeAlgebra + deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable) + +type FastMathFlagSet = EnumSet.T CUInt FastMathFlags + +noNaNs, noInfs, noSignedZeros, allowReciprocal, unsafeAlgebra :: FastMathFlagSet +noNaNs = EnumSet.fromEnum NoNaNs +noInfs = EnumSet.fromEnum NoInfs +noSignedZeros = EnumSet.fromEnum NoSignedZeros +allowReciprocal = EnumSet.fromEnum AllowReciprocal +unsafeAlgebra = EnumSet.fromEnum UnsafeAlgebra + +foreign import ccall unsafe "LLVMSetFastMathFlags" setFastMathFlags + :: ValueRef -> FastMathFlagSet -> IO () + -- ** Memory foreign import ccall unsafe "LLVMBuildMalloc" buildMalloc diff --git a/src/LLVM/FFI/ExecutionEngine.hs b/src/LLVM/FFI/ExecutionEngine.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/ExecutionEngine.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module LLVM.FFI.ExecutionEngine + ( + -- * Linking + linkInInterpreter + , linkInJIT + , linkInMCJIT + + -- * Generic values + , GenericValue + , GenericValueRef + , createGenericValueOfInt + , createGenericValueOfPointer + , createGenericValueOfFloat + , genericValueIntWidth + , genericValueToInt + , genericValueToPointer + , genericValueToFloat + , ptrDisposeGenericValue + + -- * Execution engines + , ExecutionEngine + , ExecutionEngineRef + , createExecutionEngineForModule + , createExecutionEngineForModuleCPU + , createInterpreterForModule + , createJITCompilerForModule + , createMCJITCompilerForModule + , initializeMCJITCompilerOptions + , createExecutionEngine + , createInterpreter + , createJITCompiler + , ptrDisposeExecutionEngine + , disposeExecutionEngine + , runStaticConstructors + , runStaticDestructors + , runFunctionAsMain + , freeMachineCodeForFunction + , addModule + , addModuleProvider + , removeModule + , removeModuleProvider + , findFunction + , recompileAndRelinkFunction + , runFunction + , getExecutionEngineTargetData + , addGlobalMapping + , addFunctionMapping + , getPointerToGlobal + + ) where + +import LLVM.FFI.Core (ModuleRef, ModuleProviderRef, TypeRef, ValueRef) +import LLVM.FFI.Target(TargetDataRef) + +import qualified Foreign.C.Types as C +import Foreign.C.String (CString) +import Foreign.Ptr (Ptr, FunPtr) + +import Data.Typeable (Typeable) + + +type CDouble = C.CDouble +type CInt = C.CInt +type CUInt = C.CUInt +type CULLong = C.CULLong +type CSize = C.CSize + + +data ExecutionEngine + deriving (Typeable) +type ExecutionEngineRef = Ptr ExecutionEngine + +data GenericValue + deriving (Typeable) +type GenericValueRef = Ptr GenericValue + +data MCJITCompilerOptions + deriving (Typeable) +type MCJITCompilerOptionsRef = Ptr MCJITCompilerOptions + +-- ** Linking +foreign import ccall unsafe "LLVMLinkInInterpreter" linkInInterpreter + :: IO () +foreign import ccall unsafe "LLVMLinkInJIT" linkInJIT + :: IO () +foreign import ccall unsafe "LLVMLinkInMCJIT" linkInMCJIT + :: IO () + +-- ** Generic values +foreign import ccall unsafe "LLVMCreateGenericValueOfInt" + createGenericValueOfInt :: TypeRef -> CULLong -> CInt + -> IO GenericValueRef +foreign import ccall unsafe "LLVMCreateGenericValueOfPointer" + createGenericValueOfPointer :: Ptr a -> IO GenericValueRef +foreign import ccall unsafe "LLVMCreateGenericValueOfFloat" + createGenericValueOfFloat :: TypeRef -> CDouble -> IO GenericValueRef +foreign import ccall unsafe "LLVMGenericValueIntWidth" genericValueIntWidth + :: GenericValueRef -> IO CUInt +foreign import ccall unsafe "LLVMGenericValueToInt" genericValueToInt + :: GenericValueRef -> CInt -> IO CULLong +foreign import ccall unsafe "LLVMGenericValueToPointer" genericValueToPointer + :: GenericValueRef -> IO (Ptr a) +foreign import ccall unsafe "LLVMGenericValueToFloat" genericValueToFloat + :: TypeRef -> GenericValueRef -> IO CDouble +foreign import ccall unsafe "&LLVMDisposeGenericValue" ptrDisposeGenericValue + :: FunPtr (GenericValueRef -> IO ()) + +-- ** Execution engines +foreign import ccall unsafe "LLVMCreateExecutionEngineForModule" createExecutionEngineForModule + :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO Bool +foreign import ccall unsafe "LLVMCreateExecutionEngineForModuleCPU" createExecutionEngineForModuleCPU + :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO Bool +foreign import ccall unsafe "LLVMCreateInterpreterForModule" createInterpreterForModule + :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO Bool +foreign import ccall unsafe "LLVMCreateJITCompilerForModule" createJITCompilerForModule + :: (Ptr ExecutionEngineRef) -> ModuleRef -> CUInt -> (Ptr CString) -> IO Bool +foreign import ccall unsafe "LLVMInitializeMCJITCompilerOptions" initializeMCJITCompilerOptions + :: MCJITCompilerOptionsRef -> CSize -> IO () +foreign import ccall unsafe "LLVMCreateMCJITCompilerForModule" createMCJITCompilerForModule + :: Ptr ExecutionEngineRef -> ModuleRef -> MCJITCompilerOptionsRef -> CSize -> Ptr CString -> IO Bool +foreign import ccall unsafe "LLVMCreateExecutionEngine" createExecutionEngine + :: Ptr ExecutionEngineRef -> ModuleProviderRef -> Ptr CString + -> IO CInt +foreign import ccall unsafe "LLVMCreateInterpreter" createInterpreter + :: Ptr ExecutionEngineRef -> ModuleProviderRef -> Ptr CString -> IO CInt +foreign import ccall unsafe "LLVMCreateJITCompiler" createJITCompiler + :: Ptr ExecutionEngineRef -> ModuleProviderRef -> CUInt -> Ptr CString -> IO CInt +foreign import ccall unsafe "LLVMDisposeExecutionEngine" disposeExecutionEngine + :: ExecutionEngineRef -> IO () +foreign import ccall unsafe "&LLVMDisposeExecutionEngine" ptrDisposeExecutionEngine + :: FunPtr (ExecutionEngineRef -> IO ()) +foreign import ccall unsafe "LLVMRunStaticConstructors" runStaticConstructors + :: ExecutionEngineRef -> IO () +foreign import ccall unsafe "LLVMRunStaticDestructors" runStaticDestructors + :: ExecutionEngineRef -> IO () +{- +safe call is important, since the running LLVM code may call back into Haskell code + +See +http://www.cse.unsw.edu.au/~chak/haskell/ffi/ffi/ffise3.html#x6-130003.3 says: + +"Optionally, an import declaration can specify, +after the calling convention, +the safety level that should be used when invoking an external entity. +..." +-} +foreign import ccall safe "LLVMRunFunctionAsMain" runFunctionAsMain + :: ExecutionEngineRef -> ValueRef -> CUInt + -> Ptr CString -- ^ argv + -> Ptr CString -- ^ envp + -> IO CInt +foreign import ccall safe "LLVMRunFunction" runFunction + :: ExecutionEngineRef -> ValueRef -> CUInt + -> Ptr GenericValueRef -> IO GenericValueRef +foreign import ccall unsafe "LLVMFreeMachineCodeForFunction" + freeMachineCodeForFunction :: ExecutionEngineRef -> ValueRef -> IO () +foreign import ccall unsafe "LLVMAddModule" addModule + :: ExecutionEngineRef -> ModuleRef -> IO () +foreign import ccall unsafe "LLVMAddModuleProvider" addModuleProvider + :: ExecutionEngineRef -> ModuleProviderRef -> IO () +foreign import ccall unsafe "LLVMRemoveModule" removeModule + :: ExecutionEngineRef -> ModuleRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool +foreign import ccall unsafe "LLVMRemoveModuleProvider" removeModuleProvider + :: ExecutionEngineRef -> ModuleProviderRef -> Ptr ModuleRef -> Ptr CString + -> IO CInt +foreign import ccall unsafe "LLVMFindFunction" findFunction + :: ExecutionEngineRef -> CString -> Ptr ValueRef -> IO CInt +foreign import ccall unsafe "LLVMRecompileAndRelinkFunction" recompileAndRelinkFunction + :: ExecutionEngineRef -> ValueRef -> IO (FunPtr a) +foreign import ccall unsafe "LLVMGetExecutionEngineTargetData" getExecutionEngineTargetData + :: ExecutionEngineRef -> IO TargetDataRef +foreign import ccall unsafe "LLVMAddGlobalMapping" addGlobalMapping + :: ExecutionEngineRef -> ValueRef -> Ptr a -> IO () +foreign import ccall unsafe "LLVMAddGlobalMapping" addFunctionMapping + :: ExecutionEngineRef -> ValueRef -> FunPtr a -> IO () +foreign import ccall unsafe "LLVMGetPointerToGlobal" getPointerToGlobal + :: ExecutionEngineRef -> ValueRef -> IO (FunPtr a) diff --git a/src/LLVM/FFI/ExecutionEngine.hsc b/src/LLVM/FFI/ExecutionEngine.hsc deleted file mode 100644 --- a/src/LLVM/FFI/ExecutionEngine.hsc +++ /dev/null @@ -1,165 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE DeriveDataTypeable #-} - -module LLVM.FFI.ExecutionEngine - ( - -- * Linking - linkInInterpreter - , linkInJIT - - -- * Generic values - , GenericValue - , GenericValueRef - , createGenericValueOfInt - , createGenericValueOfPointer - , createGenericValueOfFloat - , genericValueIntWidth - , genericValueToInt - , genericValueToPointer - , genericValueToFloat - , ptrDisposeGenericValue - - -- * Execution engines - , ExecutionEngine - , ExecutionEngineRef - , createExecutionEngineForModule - , createInterpreterForModule - , createJITCompilerForModule - , createExecutionEngine - , createInterpreter - , createJITCompiler - , ptrDisposeExecutionEngine - , disposeExecutionEngine - , runStaticConstructors - , runStaticDestructors - , runFunctionAsMain - , freeMachineCodeForFunction - , addModule - , addModuleProvider - , removeModule - , removeModuleProvider - , findFunction - , recompileAndRelinkFunction - , runFunction - , getExecutionEngineTargetData - , addGlobalMapping - , addFunctionMapping - , getPointerToGlobal - - ) where - -import LLVM.FFI.Core (ModuleRef, ModuleProviderRef, TypeRef, ValueRef) -import LLVM.FFI.Target(TargetDataRef) - -import qualified Foreign.C.Types as C -import Foreign.C.String (CString) -import Foreign.Ptr (Ptr, FunPtr) - -import Data.Typeable (Typeable) - - -type CDouble = C.CDouble -type CInt = C.CInt -type CUInt = C.CUInt -type CULLong = C.CULLong - - -data ExecutionEngine - deriving (Typeable) -type ExecutionEngineRef = Ptr ExecutionEngine - -data GenericValue - deriving (Typeable) -type GenericValueRef = Ptr GenericValue - --- ** Linking -foreign import ccall unsafe "LLVMLinkInInterpreter" linkInInterpreter - :: IO () -foreign import ccall unsafe "LLVMLinkInJIT" linkInJIT - :: IO () - --- ** Generic values -foreign import ccall unsafe "LLVMCreateGenericValueOfInt" - createGenericValueOfInt :: TypeRef -> CULLong -> CInt - -> IO GenericValueRef -foreign import ccall unsafe "LLVMCreateGenericValueOfPointer" - createGenericValueOfPointer :: Ptr a -> IO GenericValueRef -foreign import ccall unsafe "LLVMCreateGenericValueOfFloat" - createGenericValueOfFloat :: TypeRef -> CDouble -> IO GenericValueRef -foreign import ccall unsafe "LLVMGenericValueIntWidth" genericValueIntWidth - :: GenericValueRef -> IO CUInt -foreign import ccall unsafe "LLVMGenericValueToInt" genericValueToInt - :: GenericValueRef -> CInt -> IO CULLong -foreign import ccall unsafe "LLVMGenericValueToPointer" genericValueToPointer - :: GenericValueRef -> IO (Ptr a) -foreign import ccall unsafe "LLVMGenericValueToFloat" genericValueToFloat - :: TypeRef -> GenericValueRef -> IO CDouble -foreign import ccall unsafe "&LLVMDisposeGenericValue" ptrDisposeGenericValue - :: FunPtr (GenericValueRef -> IO ()) - --- ** Execution engines -foreign import ccall unsafe "LLVMCreateExecutionEngineForModule" createExecutionEngineForModule - :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO Bool -foreign import ccall unsafe "LLVMCreateInterpreterForModule" createInterpreterForModule - :: (Ptr ExecutionEngineRef) -> ModuleRef -> (Ptr CString) -> IO Bool -foreign import ccall unsafe "LLVMCreateJITCompilerForModule" createJITCompilerForModule - :: (Ptr ExecutionEngineRef) -> ModuleRef -> CUInt -> (Ptr CString) -> IO Bool -foreign import ccall unsafe "LLVMCreateExecutionEngine" createExecutionEngine - :: Ptr ExecutionEngineRef -> ModuleProviderRef -> Ptr CString - -> IO CInt -foreign import ccall unsafe "LLVMCreateInterpreter" createInterpreter - :: Ptr ExecutionEngineRef -> ModuleProviderRef -> Ptr CString -> IO CInt -foreign import ccall unsafe "LLVMCreateJITCompiler" createJITCompiler - :: Ptr ExecutionEngineRef -> ModuleProviderRef -> CUInt -> Ptr CString -> IO CInt -foreign import ccall unsafe "LLVMDisposeExecutionEngine" disposeExecutionEngine - :: ExecutionEngineRef -> IO () -foreign import ccall unsafe "&LLVMDisposeExecutionEngine" ptrDisposeExecutionEngine - :: FunPtr (ExecutionEngineRef -> IO ()) -foreign import ccall unsafe "LLVMRunStaticConstructors" runStaticConstructors - :: ExecutionEngineRef -> IO () -foreign import ccall unsafe "LLVMRunStaticDestructors" runStaticDestructors - :: ExecutionEngineRef -> IO () -{- -safe call is important, since the running LLVM code may call back into Haskell code - -See -http://www.cse.unsw.edu.au/~chak/haskell/ffi/ffi/ffise3.html#x6-130003.3 says: - -"Optionally, an import declaration can specify, -after the calling convention, -the safety level that should be used when invoking an external entity. -..." --} -foreign import ccall safe "LLVMRunFunctionAsMain" runFunctionAsMain - :: ExecutionEngineRef -> ValueRef -> CUInt - -> Ptr CString -- ^ argv - -> Ptr CString -- ^ envp - -> IO CInt -foreign import ccall safe "LLVMRunFunction" runFunction - :: ExecutionEngineRef -> ValueRef -> CUInt - -> Ptr GenericValueRef -> IO GenericValueRef -foreign import ccall unsafe "LLVMFreeMachineCodeForFunction" - freeMachineCodeForFunction :: ExecutionEngineRef -> ValueRef -> IO () -foreign import ccall unsafe "LLVMAddModule" addModule - :: ExecutionEngineRef -> ModuleRef -> IO () -foreign import ccall unsafe "LLVMAddModuleProvider" addModuleProvider - :: ExecutionEngineRef -> ModuleProviderRef -> IO () -foreign import ccall unsafe "LLVMRemoveModule" removeModule - :: ExecutionEngineRef -> ModuleRef -> (Ptr ModuleRef) -> (Ptr CString) -> IO Bool -foreign import ccall unsafe "LLVMRemoveModuleProvider" removeModuleProvider - :: ExecutionEngineRef -> ModuleProviderRef -> Ptr ModuleRef -> Ptr CString - -> IO CInt -foreign import ccall unsafe "LLVMFindFunction" findFunction - :: ExecutionEngineRef -> CString -> Ptr ValueRef -> IO CInt -foreign import ccall unsafe "LLVMRecompileAndRelinkFunction" recompileAndRelinkFunction - :: ExecutionEngineRef -> ValueRef -> IO (FunPtr a) -foreign import ccall unsafe "LLVMGetExecutionEngineTargetData" getExecutionEngineTargetData - :: ExecutionEngineRef -> IO TargetDataRef -foreign import ccall unsafe "LLVMAddGlobalMapping" addGlobalMapping - :: ExecutionEngineRef -> ValueRef -> Ptr a -> IO () -foreign import ccall unsafe "LLVMAddGlobalMapping" addFunctionMapping - :: ExecutionEngineRef -> ValueRef -> FunPtr a -> IO () -foreign import ccall unsafe "LLVMGetPointerToGlobal" getPointerToGlobal - :: ExecutionEngineRef -> ValueRef -> IO (FunPtr a) diff --git a/src/LLVM/FFI/Support.hs b/src/LLVM/FFI/Support.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/Support.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +module LLVM.FFI.Support + ( + createStandardModulePasses + , createStandardFunctionPasses + ) where + +import qualified Foreign.C.Types as C + +import LLVM.FFI.Core (PassManagerRef) + + +type CUInt = C.CUInt +type CInt = C.CInt + + +foreign import ccall unsafe "LLVMCreateStandardFunctionPasses" createStandardFunctionPasses + :: PassManagerRef -> CUInt -> IO () + +foreign import ccall unsafe "LLVMCreateStandardModulePasses" createStandardModulePasses + :: PassManagerRef -> CUInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () diff --git a/src/LLVM/FFI/Support.hsc b/src/LLVM/FFI/Support.hsc deleted file mode 100644 --- a/src/LLVM/FFI/Support.hsc +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE ForeignFunctionInterface #-} - -module LLVM.FFI.Support - ( - createStandardModulePasses - , createStandardFunctionPasses - ) where - -import qualified Foreign.C.Types as C - -import LLVM.FFI.Core (PassManagerRef) - - -type CUInt = C.CUInt -type CInt = C.CInt - - -foreign import ccall unsafe "LLVMCreateStandardFunctionPasses" createStandardFunctionPasses - :: PassManagerRef -> CUInt -> IO () - -foreign import ccall unsafe "LLVMCreateStandardModulePasses" createStandardModulePasses - :: PassManagerRef -> CUInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO () diff --git a/src/LLVM/FFI/Support/Host.hs b/src/LLVM/FFI/Support/Host.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/Support/Host.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module LLVM.FFI.Support.Host ( + getHostCPUName, + getHostFeatures, + freeFeatures, + getFirstFeature, + getNextFeature, + getFeatureName, + getFeatureSupport, + ) where + +import qualified Foreign.C.Types as C +import Foreign.C.String (CString) +import Foreign.Ptr (Ptr) + +import Data.Typeable (Typeable) + + +foreign import ccall unsafe "LLVMGetHostCPUName" getHostCPUName + :: Ptr C.CSize -> IO CString + + +data FeatureMap + deriving (Typeable) +type FeatureMapRef = Ptr FeatureMap + +data FeatureIterator + deriving (Typeable) +type FeatureIteratorRef = Ptr FeatureIterator + +foreign import ccall unsafe "LLVMGetHostFeatures" getHostFeatures + :: IO FeatureMapRef +foreign import ccall unsafe "LLVMFreeFeatures" freeFeatures + :: FeatureMapRef -> IO () + +foreign import ccall unsafe "LLVMGetFirstFeature" getFirstFeature + :: FeatureMapRef -> IO FeatureIteratorRef +foreign import ccall unsafe "LLVMGetNextFeature" getNextFeature + :: FeatureMapRef -> FeatureIteratorRef -> IO FeatureIteratorRef + +foreign import ccall unsafe "LLVMGetFeatureName" getFeatureName + :: FeatureIteratorRef -> IO CString +foreign import ccall unsafe "LLVMGetFeatureSupport" getFeatureSupport + :: FeatureIteratorRef -> IO Bool diff --git a/src/LLVM/FFI/Target.hs b/src/LLVM/FFI/Target.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/Target.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module LLVM.FFI.Target where + +import LLVM.FFI.Core (ValueRef, TypeRef, PassManagerRef) + +import qualified Foreign.C.Types as C +import Foreign.C.String (CString) +import Foreign.Ptr (Ptr) + +import Data.Typeable (Typeable) + + +type CUInt = C.CUInt +type CInt = C.CInt +type CULLong = C.CULLong + + +-- enum { LLVMBigEndian, LLVMLittleEndian }; +type ByteOrdering = CInt + +data TargetData + deriving (Typeable) +type TargetDataRef = Ptr TargetData + +data TargetLibraryInfo + deriving (Typeable) +type TargetLibraryInfoRef = Ptr TargetLibraryInfo + +foreign import ccall unsafe "LLVMCreateTargetData" createTargetData + :: CString -> IO TargetDataRef +foreign import ccall unsafe "LLVMAddTargetData" addTargetData + :: TargetDataRef -> PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddTargetLibraryInfo" addTargetLibraryInfo + :: TargetLibraryInfoRef -> PassManagerRef -> IO () +foreign import ccall unsafe "LLVMCopyStringRepOfTargetData" copyStringRepOfTargetData + :: TargetDataRef -> IO CString +foreign import ccall unsafe "LLVMByteOrder" byteOrder + :: TargetDataRef -> IO ByteOrdering +foreign import ccall unsafe "LLVMPointerSize" pointerSize + :: TargetDataRef -> IO CUInt +foreign import ccall unsafe "LLVMIntPtrType" intPtrType + :: TargetDataRef -> IO TypeRef +foreign import ccall unsafe "LLVMSizeOfTypeInBits" sizeOfTypeInBits + :: TargetDataRef -> TypeRef -> IO CULLong +foreign import ccall unsafe "LLVMStoreSizeOfType" storeSizeOfType + :: TargetDataRef -> TypeRef -> IO CULLong +foreign import ccall unsafe "LLVMABISizeOfType" aBISizeOfType + :: TargetDataRef -> TypeRef -> IO CULLong +foreign import ccall unsafe "LLVMABIAlignmentOfType" aBIAlignmentOfType + :: TargetDataRef -> TypeRef -> IO CULLong +foreign import ccall unsafe "LLVMCallFrameAlignmentOfType" callFrameAlignmentOfType + :: TargetDataRef -> TypeRef -> IO CULLong +foreign import ccall unsafe "LLVMPreferredAlignmentOfType" preferredAlignmentOfType + :: TargetDataRef -> TypeRef -> IO CULLong +foreign import ccall unsafe "LLVMPreferredAlignmentOfGlobal" preferredAlignmentOfGlobal + :: TargetDataRef -> ValueRef -> IO CUInt +foreign import ccall unsafe "LLVMElementAtOffset" elementAtOffset + :: TargetDataRef -> TypeRef -> CULLong -> IO CUInt +foreign import ccall unsafe "LLVMOffsetOfElement" offsetOfElement + :: TargetDataRef -> TypeRef -> CUInt -> IO CULLong +foreign import ccall unsafe "LLVMDisposeTargetData" disposeTargetData + :: TargetDataRef -> IO () diff --git a/src/LLVM/FFI/Target.hsc b/src/LLVM/FFI/Target.hsc deleted file mode 100644 --- a/src/LLVM/FFI/Target.hsc +++ /dev/null @@ -1,66 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE EmptyDataDecls #-} -{-# LANGUAGE DeriveDataTypeable #-} - -module LLVM.FFI.Target where - -import LLVM.FFI.Core (ValueRef, TypeRef, PassManagerRef) - -import qualified Foreign.C.Types as C -import Foreign.C.String (CString) -import Foreign.Ptr (Ptr) - -import Data.Typeable (Typeable) - - -type CUInt = C.CUInt -type CInt = C.CInt -type CULLong = C.CULLong - - --- enum { LLVMBigEndian, LLVMLittleEndian }; -type ByteOrdering = CInt - -data TargetData - deriving (Typeable) -type TargetDataRef = Ptr TargetData - -data TargetLibraryInfo - deriving (Typeable) -type TargetLibraryInfoRef = Ptr TargetLibraryInfo - -foreign import ccall unsafe "LLVMCreateTargetData" createTargetData - :: CString -> IO TargetDataRef -foreign import ccall unsafe "LLVMAddTargetData" addTargetData - :: TargetDataRef -> PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddTargetLibraryInfo" addTargetLibraryInfo - :: TargetLibraryInfoRef -> PassManagerRef -> IO () -foreign import ccall unsafe "LLVMCopyStringRepOfTargetData" copyStringRepOfTargetData - :: TargetDataRef -> IO CString -foreign import ccall unsafe "LLVMByteOrder" byteOrder - :: TargetDataRef -> IO ByteOrdering -foreign import ccall unsafe "LLVMPointerSize" pointerSize - :: TargetDataRef -> IO CUInt -foreign import ccall unsafe "LLVMIntPtrType" intPtrType - :: TargetDataRef -> IO TypeRef -foreign import ccall unsafe "LLVMSizeOfTypeInBits" sizeOfTypeInBits - :: TargetDataRef -> TypeRef -> IO CULLong -foreign import ccall unsafe "LLVMStoreSizeOfType" storeSizeOfType - :: TargetDataRef -> TypeRef -> IO CULLong -foreign import ccall unsafe "LLVMABISizeOfType" aBISizeOfType - :: TargetDataRef -> TypeRef -> IO CULLong -foreign import ccall unsafe "LLVMABIAlignmentOfType" aBIAlignmentOfType - :: TargetDataRef -> TypeRef -> IO CULLong -foreign import ccall unsafe "LLVMCallFrameAlignmentOfType" callFrameAlignmentOfType - :: TargetDataRef -> TypeRef -> IO CULLong -foreign import ccall unsafe "LLVMPreferredAlignmentOfType" preferredAlignmentOfType - :: TargetDataRef -> TypeRef -> IO CULLong -foreign import ccall unsafe "LLVMPreferredAlignmentOfGlobal" preferredAlignmentOfGlobal - :: TargetDataRef -> ValueRef -> IO CUInt -foreign import ccall unsafe "LLVMElementAtOffset" elementAtOffset - :: TargetDataRef -> TypeRef -> CULLong -> IO CUInt -foreign import ccall unsafe "LLVMOffsetOfElement" offsetOfElement - :: TargetDataRef -> TypeRef -> CUInt -> IO CULLong -foreign import ccall unsafe "LLVMDisposeTargetData" disposeTargetData - :: TargetDataRef -> IO () diff --git a/src/LLVM/FFI/Transforms/IPO.hs b/src/LLVM/FFI/Transforms/IPO.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/Transforms/IPO.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} + +module LLVM.FFI.Transforms.IPO where + +import LLVM.FFI.Core (PassManagerRef) + + +foreign import ccall unsafe "LLVMAddArgumentPromotionPass" addArgumentPromotionPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddConstantMergePass" addConstantMergePass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddDeadArgEliminationPass" addDeadArgEliminationPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddFunctionAttrsPass" addFunctionAttrsPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddFunctionInliningPass" addFunctionInliningPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddAlwaysInlinerPass" addAlwaysInlinerPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddGlobalDCEPass" addGlobalDCEPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddGlobalOptimizerPass" addGlobalOptimizerPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddIPConstantPropagationPass" addIPConstantPropagationPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddPruneEHPass" addPruneEHPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddIPSCCPPass" addIPSCCPPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddInternalizePass" addInternalizePass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddStripDeadPrototypesPass" addStripDeadPrototypesPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddStripSymbolsPass" addStripSymbolsPass + :: PassManagerRef -> IO () diff --git a/src/LLVM/FFI/Transforms/IPO.hsc b/src/LLVM/FFI/Transforms/IPO.hsc deleted file mode 100644 --- a/src/LLVM/FFI/Transforms/IPO.hsc +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE EmptyDataDecls #-} - -module LLVM.FFI.Transforms.IPO where - -import LLVM.FFI.Core (PassManagerRef) - - -foreign import ccall unsafe "LLVMAddArgumentPromotionPass" addArgumentPromotionPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddConstantMergePass" addConstantMergePass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddDeadArgEliminationPass" addDeadArgEliminationPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddFunctionAttrsPass" addFunctionAttrsPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddFunctionInliningPass" addFunctionInliningPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddAlwaysInlinerPass" addAlwaysInlinerPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddGlobalDCEPass" addGlobalDCEPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddGlobalOptimizerPass" addGlobalOptimizerPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddIPConstantPropagationPass" addIPConstantPropagationPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddPruneEHPass" addPruneEHPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddIPSCCPPass" addIPSCCPPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddInternalizePass" addInternalizePass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddStripDeadPrototypesPass" addStripDeadPrototypesPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddStripSymbolsPass" addStripSymbolsPass - :: PassManagerRef -> IO () diff --git a/src/LLVM/FFI/Transforms/PassManagerBuilder.hs b/src/LLVM/FFI/Transforms/PassManagerBuilder.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/Transforms/PassManagerBuilder.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module LLVM.FFI.Transforms.PassManagerBuilder where + +import LLVM.FFI.Core (PassManagerRef) + +import qualified Foreign.C.Types as C +import Foreign.Ptr (Ptr) + +import Data.Typeable (Typeable) + + +type CDouble = C.CDouble +type CInt = C.CInt +type CUInt = C.CUInt +type CLLong = C.CLLong +type CULLong = C.CULLong + + +data PassManagerBuilder + deriving (Typeable) +type PassManagerBuilderRef = Ptr PassManagerBuilder + + +foreign import ccall unsafe "LLVMPassManagerBuilderCreate" create + :: IO PassManagerBuilderRef + +foreign import ccall unsafe "LLVMPassManagerBuilderDispose" dispose + :: PassManagerBuilderRef -> IO () + +foreign import ccall unsafe "LLVMPassManagerBuilderSetOptLevel" setOptLevel + :: PassManagerBuilderRef -> CUInt -> IO () + +foreign import ccall unsafe "LLVMPassManagerBuilderSetSizeLevel" setSizeLevel + :: PassManagerBuilderRef -> CUInt -> IO () + +foreign import ccall unsafe "LLVMPassManagerBuilderSetDisableUnitAtATime" setDisableUnitAtATime + :: PassManagerBuilderRef -> CUInt{-Bool-} -> IO () + +foreign import ccall unsafe "LLVMPassManagerBuilderSetDisableUnrollLoops" setDisableUnrollLoops + :: PassManagerBuilderRef -> CUInt{-Bool-} -> IO () + +foreign import ccall unsafe "LLVMPassManagerBuilderSetDisableSimplifyLibCalls" setDisableSimplifyLibCalls + :: PassManagerBuilderRef -> CUInt{-Bool-} -> IO () + +foreign import ccall unsafe "LLVMPassManagerBuilderUseInlinerWithThreshold" useInlinerWithThreshold + :: PassManagerBuilderRef -> CUInt -> IO () + +foreign import ccall unsafe "LLVMPassManagerBuilderPopulateFunctionPassManager" populateFunctionPassManager + :: PassManagerBuilderRef -> PassManagerRef -> IO () + +foreign import ccall unsafe "LLVMPassManagerBuilderPopulateModulePassManager" populateModulePassManager + :: PassManagerBuilderRef -> PassManagerRef -> IO () + +foreign import ccall unsafe "LLVMPassManagerBuilderPopulateLTOPassManager" populateLTOPassManager + :: PassManagerBuilderRef -> PassManagerRef -> CUInt{-Bool-} -> CUInt{-Bool-} -> IO () diff --git a/src/LLVM/FFI/Transforms/Scalar.hs b/src/LLVM/FFI/Transforms/Scalar.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/Transforms/Scalar.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE EmptyDataDecls #-} + +module LLVM.FFI.Transforms.Scalar where + +import LLVM.FFI.Core (PassManagerRef) + + +foreign import ccall unsafe "LLVMAddAggressiveDCEPass" addAggressiveDCEPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddCFGSimplificationPass" addCFGSimplificationPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddDeadStoreEliminationPass" addDeadStoreEliminationPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddGVNPass" addGVNPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddIndVarSimplifyPass" addIndVarSimplifyPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddInstructionCombiningPass" addInstructionCombiningPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddJumpThreadingPass" addJumpThreadingPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddLICMPass" addLICMPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddLoopDeletionPass" addLoopDeletionPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddLoopIdiomPass" addLoopIdiomPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddLoopRotatePass" addLoopRotatePass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddLoopUnrollPass" addLoopUnrollPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddLoopUnswitchPass" addLoopUnswitchPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddMemCpyOptPass" addMemCpyOptPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddPromoteMemoryToRegisterPass" addPromoteMemoryToRegisterPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddReassociatePass" addReassociatePass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddSCCPPass" addSCCPPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddScalarReplAggregatesPass" addScalarReplAggregatesPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddScalarReplAggregatesPassSSA" addScalarReplAggregatesPassSSA + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddScalarReplAggregatesPassWithThreshold" + addScalarReplAggregatesPassWithThreshold + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddSimplifyLibCallsPass" addSimplifyLibCallsPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddTailCallEliminationPass" addTailCallEliminationPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddConstantPropagationPass" addConstantPropagationPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddDemoteMemoryToRegisterPass" addDemoteMemoryToRegisterPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddVerifierPass" addVerifierPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddCorrelatedValuePropagationPass" addCorrelatedValuePropagationPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddEarlyCSEPass" addEarlyCSEPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddLowerExpectIntrinsicPass" addLowerExpectIntrinsicPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddTypeBasedAliasAnalysisPass" addTypeBasedAliasAnalysisPass + :: PassManagerRef -> IO () +foreign import ccall unsafe "LLVMAddBasicAliasAnalysisPass" addBasicAliasAnalysisPass + :: PassManagerRef -> IO () diff --git a/src/LLVM/FFI/Transforms/Scalar.hsc b/src/LLVM/FFI/Transforms/Scalar.hsc deleted file mode 100644 --- a/src/LLVM/FFI/Transforms/Scalar.hsc +++ /dev/null @@ -1,70 +0,0 @@ -{-# LANGUAGE Safe #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE EmptyDataDecls #-} - -module LLVM.FFI.Transforms.Scalar where - -import LLVM.FFI.Core (PassManagerRef) - - -foreign import ccall unsafe "LLVMAddAggressiveDCEPass" addAggressiveDCEPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddCFGSimplificationPass" addCFGSimplificationPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddDeadStoreEliminationPass" addDeadStoreEliminationPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddGVNPass" addGVNPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddIndVarSimplifyPass" addIndVarSimplifyPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddInstructionCombiningPass" addInstructionCombiningPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddJumpThreadingPass" addJumpThreadingPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddLICMPass" addLICMPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddLoopDeletionPass" addLoopDeletionPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddLoopIdiomPass" addLoopIdiomPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddLoopRotatePass" addLoopRotatePass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddLoopUnrollPass" addLoopUnrollPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddLoopUnswitchPass" addLoopUnswitchPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddMemCpyOptPass" addMemCpyOptPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddPromoteMemoryToRegisterPass" addPromoteMemoryToRegisterPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddReassociatePass" addReassociatePass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddSCCPPass" addSCCPPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddScalarReplAggregatesPass" addScalarReplAggregatesPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddScalarReplAggregatesPassSSA" addScalarReplAggregatesPassSSA - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddScalarReplAggregatesPassWithThreshold" - addScalarReplAggregatesPassWithThreshold - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddSimplifyLibCallsPass" addSimplifyLibCallsPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddTailCallEliminationPass" addTailCallEliminationPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddConstantPropagationPass" addConstantPropagationPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddDemoteMemoryToRegisterPass" addDemoteMemoryToRegisterPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddVerifierPass" addVerifierPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddCorrelatedValuePropagationPass" addCorrelatedValuePropagationPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddEarlyCSEPass" addEarlyCSEPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddLowerExpectIntrinsicPass" addLowerExpectIntrinsicPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddTypeBasedAliasAnalysisPass" addTypeBasedAliasAnalysisPass - :: PassManagerRef -> IO () -foreign import ccall unsafe "LLVMAddBasicAliasAnalysisPass" addBasicAliasAnalysisPass - :: PassManagerRef -> IO () diff --git a/src/LLVM/FFI/Transforms/Vectorize.hs b/src/LLVM/FFI/Transforms/Vectorize.hs new file mode 100644 --- /dev/null +++ b/src/LLVM/FFI/Transforms/Vectorize.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE Safe #-} +{-# LANGUAGE ForeignFunctionInterface #-} +module LLVM.FFI.Transforms.Vectorize where + +import LLVM.FFI.Core (PassManagerRef) + + +foreign import ccall unsafe "LLVMAddBBVectorizePass" addBBPass + :: PassManagerRef -> IO () + +foreign import ccall unsafe "LLVMAddLoopVectorizePass" addLoopPass + :: PassManagerRef -> IO () + +foreign import ccall unsafe "LLVMAddSLPVectorizePass" addSLPPass + :: PassManagerRef -> IO () diff --git a/tool/FunctionMangulation.hs b/tool/FunctionMangulation.hs --- a/tool/FunctionMangulation.hs +++ b/tool/FunctionMangulation.hs @@ -34,6 +34,7 @@ "void" -> "()" "const char *" -> "CString" "char *" -> "CString" + "size_t" -> "CSize" _ -> case reverse cname of '*':ps -> "(Ptr " ++ rename (reverse ps) ++ ")" diff --git a/tool/ltrace.config b/tool/ltrace.config --- a/tool/ltrace.config +++ b/tool/ltrace.config @@ -387,7 +387,7 @@ void LLVMDeleteFunction(LLVMValueRef); uint LLVMGetIntrinsicID(LLVMValueRef); uint LLVMGetFunctionCallConv(LLVMValueRef); -void LLVMSetFunctionCallConv(LLVMValueRef, uint); +void LLVMSetFunctionCallConv(LLVMValueRef, LLVMCallConv); string LLVMGetGC(LLVMValueRef); void LLVMSetGC(LLVMValueRef, string); void LLVMAddFunctionAttr(LLVMValueRef, LLVMAttribute); @@ -435,7 +435,7 @@ addr LLVMGetNextInstruction(LLVMValueRef); ; result LLVMValueRef addr LLVMGetPreviousInstruction(LLVMValueRef); ; result LLVMValueRef -void LLVMSetInstructionCallConv(LLVMValueRef, uint); +void LLVMSetInstructionCallConv(LLVMValueRef, LLVMCallConv); uint LLVMGetInstructionCallConv(LLVMValueRef); void LLVMAddInstrAttribute(LLVMValueRef, uint, LLVMAttribute); void LLVMRemoveInstrAttribute(LLVMValueRef, uint, LLVMAttribute);