From 2d925912c38c2557ac853fb1b6de5fd6e5d4c5b5 Mon Sep 17 00:00:00 2001 From: David Robillard Date: Sun, 28 Jun 2009 23:29:27 +0000 Subject: Move code into src directory. git-svn-id: http://svn.drobilla.net/resp/tuplr@160 ad02d1e2-f140-0410-9f75-f8b11f17cedd --- src/llvm.cpp | 544 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 544 insertions(+) create mode 100644 src/llvm.cpp (limited to 'src/llvm.cpp') diff --git a/src/llvm.cpp b/src/llvm.cpp new file mode 100644 index 0000000..b5e397e --- /dev/null +++ b/src/llvm.cpp @@ -0,0 +1,544 @@ +/* Tuplr: A programming language + * Copyright (C) 2008-2009 David Robillard + * + * Tuplr is free software: you can redistribute it and/or modify it under + * the terms of the GNU Affero General Public License as published by the + * Free Software Foundation, either version 3 of the License, or (at your + * option) any later version. + * + * Tuplr is distributed in the hope that it will be useful, but WITHOUT + * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY + * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General + * Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with Tuplr. If not, see . + */ + +#include +#include +#include +#include "llvm/Analysis/Verifier.h" +#include "llvm/Assembly/AsmAnnotationWriter.h" +#include "llvm/DerivedTypes.h" +#include "llvm/ExecutionEngine/ExecutionEngine.h" +#include "llvm/Instructions.h" +#include "llvm/Module.h" +#include "llvm/ModuleProvider.h" +#include "llvm/PassManager.h" +#include "llvm/Support/IRBuilder.h" +#include "llvm/Target/TargetData.h" +#include "llvm/Transforms/Scalar.h" +#include "tuplr.hpp" + +using namespace llvm; +using namespace std; +using boost::format; + +static inline Value* llVal(CValue v) { return static_cast(v); } +static inline Function* llFunc(CFunction f) { return static_cast(f); } + +static const Type* +llType(const AType* t) +{ + if (t->kind == AType::PRIM) { + if (t->at(0)->str() == "Nothing") return Type::VoidTy; + if (t->at(0)->str() == "Bool") return Type::Int1Ty; + if (t->at(0)->str() == "Int") return Type::Int32Ty; + if (t->at(0)->str() == "Float") return Type::FloatTy; + throw Error(t->loc, string("Unknown primitive type `") + t->str() + "'"); + /*} else if (t->kind == AType::EXPR && t->at(0)->str() == "Fn") { + AType* retT = t->at(2)->as(); + if (!llType(retT)) + return NULL; + + vector cprot; + const ATuple* prot = t->at(1)->to(); + for (size_t i = 0; i < prot->size(); ++i) { + AType* at = prot->at(i)->to(); + const Type* lt = llType(at); + if (lt) + cprot.push_back(lt); + else + return NULL; + } + + FunctionType* fT = FunctionType::get(llType(retT), cprot, false); + return PointerType::get(fT, 0); + */ + } + return NULL; // non-primitive type +} + + +/*************************************************************************** + * LLVM Engine * + ***************************************************************************/ + +struct LLVMEngine : public Engine { + LLVMEngine() + : module(new Module("tuplr")) + , engine(ExecutionEngine::create(module)) + , emp(module) + , opt(&emp) + { + // Set up optimiser pipeline + const TargetData* target = engine->getTargetData(); + opt.add(new TargetData(*target)); // Register target arch + opt.add(createInstructionCombiningPass()); // Simple optimizations + opt.add(createReassociatePass()); // Reassociate expressions + opt.add(createGVNPass()); // Eliminate Common Subexpressions + opt.add(createCFGSimplificationPass()); // Simplify control flow + + // Declare host provided allocation primitive + std::vector argsT(1, Type::Int32Ty); // unsigned size + argsT.push_back(Type::Int8Ty); // char tag + FunctionType* funcT = FunctionType::get(PointerType::get(Type::Int8Ty, 0), argsT, false); + alloc = Function::Create(funcT, Function::ExternalLinkage, + "tuplr_gc_allocate", module); + } + + CFunction startFunction(CEnv& cenv, + const std::string& name, const AType* retT, const ATuple& argsT, + const vector argNames) + { + Function::LinkageTypes linkage = Function::ExternalLinkage; + + vector cprot; + for (size_t i = 0; i < argsT.size(); ++i) { + AType* at = argsT.at(i)->as(); + THROW_IF(!llType(at), Cursor(), string("parameter has non-concrete type ") + + at->str()) + cprot.push_back(llType(at)); + } + + THROW_IF(!llType(retT), Cursor(), "return has non-concrete type"); + FunctionType* fT = FunctionType::get(llType(retT), cprot, false); + Function* f = Function::Create(fT, linkage, name, module); + + // Note f->getName() may be different from name + // however LLVM chooses to mangle is fine, we keep a pointer + + // Set argument names in generated code + Function::arg_iterator a = f->arg_begin(); + if (!argNames.empty()) + for (size_t i = 0; i != argsT.size(); ++a, ++i) + a->setName(argNames.at(i)); + + BasicBlock* bb = BasicBlock::Create("entry", f); + builder.SetInsertPoint(bb); + + return f; + } + + void finishFunction(CEnv& cenv, CFunction f, const AType* retT, CValue ret) { + if (retT->concrete()) { + Value* retVal = llVal(ret); + builder.CreateRet(retVal); + } else { + builder.CreateRetVoid(); + } + + /*std::cerr << "MODULE {" << endl; + module->dump(); + std::cerr << "}" << endl;*/ + verifyFunction(*static_cast(f)); + if (cenv.args.find("-g") == cenv.args.end()) + opt.run(*static_cast(f)); + } + + void eraseFunction(CEnv& cenv, CFunction f) { + if (f) + llFunc(f)->eraseFromParent(); + } + + void writeModule(CEnv& cenv, std::ostream& os) { + AssemblyAnnotationWriter writer; + module->print(os, &writer); + } + + const string call(CEnv& cenv, CFunction f, AType* retT) { + void* fp = engine->getPointerToFunction(llFunc(f)); + const Type* t = llType(retT); + THROW_IF(!fp, Cursor(), "unable to get function pointer"); + THROW_IF(!t, Cursor(), "function with non-concrete return type called"); + + std::stringstream ss; + if (t == Type::Int32Ty) + ss << ((int32_t (*)())fp)(); + else if (t == Type::FloatTy) + ss << showpoint << ((float (*)())fp)(); + else if (t == Type::Int1Ty) + ss << (((bool (*)())fp)() ? "#t" : "#f"); + else + ss << ((void* (*)())fp)(); + return ss.str(); + } + + Module* module; + ExecutionEngine* engine; + IRBuilder<> builder; + CFunction alloc; + ExistingModuleProvider emp; + FunctionPassManager opt; +}; + +static LLVMEngine* +llEngine(CEnv& cenv) +{ + return reinterpret_cast(cenv.engine()); +} + +/// Shared library entry point +Engine* +tuplr_new_engine() +{ + return new LLVMEngine(); +} + +/// Shared library entry point +void +tuplr_free_engine(Engine* engine) +{ + delete (LLVMEngine*)engine; +} + + +/*************************************************************************** + * Code Generation * + ***************************************************************************/ + +#define LITERAL(CT, NAME, COMPILED) \ +template<> CValue ALiteral::compile(CEnv& cenv) { return (COMPILED); } \ +template<> void \ +ALiteral::constrain(TEnv& tenv, Constraints& c) const { \ + c.constrain(tenv, this, tenv.named(NAME)); \ +} + +/// Literal template instantiations +LITERAL(int32_t, "Int", ConstantInt::get(Type::Int32Ty, val, true)) +LITERAL(float, "Float", ConstantFP::get(Type::FloatTy, val)) +LITERAL(bool, "Bool", ConstantInt::get(Type::Int1Ty, val, false)) + +CValue +ASymbol::compile(CEnv& cenv) +{ + return cenv.vals.ref(this); +} + +void +AFn::lift(CEnv& cenv) +{ + cenv.push(); + for (const_iterator p = prot()->begin(); p != prot()->end(); ++p) + cenv.def((*p)->as(), *p, NULL, NULL); + + // Lift body + for (size_t i = 2; i < size(); ++i) + at(i)->lift(cenv); + + cenv.pop(); + + AType* type = cenv.type(this); + if (impls.find(type) || !type->concrete()) + return; + + AType* protT = type->at(1)->as(); + liftCall(cenv, *protT); +} + +void +AFn::liftCall(CEnv& cenv, const AType& argsT) +{ + TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(this); + assert(gt != cenv.tenv.genericTypes.end()); + AType* genericType = new AType(*gt->second); + AType* thisType = genericType; + Subst argsSubst; + + if (!genericType->concrete()) { + // Build substitution to apply to generic type + assert(argsT.size() == prot()->size()); + ATuple* genericProtT = gt->second->at(1)->as(); + for (size_t i = 0; i < argsT.size(); ++i) { + const AType* genericArgT = genericProtT->at(i)->to(); + AType* callArgT = argsT.at(i)->to(); + assert(genericArgT); + assert(callArgT); + if (callArgT->kind == AType::EXPR) { + assert(genericArgT->kind == AType::EXPR); + assert(callArgT->size() == genericArgT->size()); + for (size_t i = 0; i < callArgT->size(); ++i) { + AType* gT = genericArgT->at(i)->to(); + AType* aT = callArgT->at(i)->to(); + if (gT && aT) + argsSubst.add(gT, aT); + } + } else { + argsSubst.add(genericArgT, callArgT); + } + } + + // Apply substitution to get concrete type for this call + thisType = argsSubst.apply(genericType)->as(); + THROW_IF(!thisType->concrete(), loc, + string("unable to resolve concrete type for function :: ") + + thisType->str() + "\n" + this->str()); + } + + Object::pool.addRoot(thisType); + if (impls.find(thisType)) + return; + + ATuple* protT = thisType->at(1)->as(); + + vector argNames; + for (size_t i = 0; i < prot()->size(); ++i) { + argNames.push_back(prot()->at(i)->str()); + } + + // Write function declaration + const string name = (this->name == "") ? cenv.penv.gensymstr("_fn") : this->name; + Function* f = llFunc(cenv.engine()->startFunction(cenv, name, + thisType->at(thisType->size()-1)->to(), + *protT, argNames)); + + cenv.push(); + Subst oldSubst = cenv.tsubst; + cenv.tsubst = Subst::compose(cenv.tsubst, Subst::compose(argsSubst, subst)); + +//#define EXPLICIT_STACK_FRAMES 1 + +#ifdef EXPLICIT_STACK_FRAMES + vector types; + types.push_back(Type::Int8Ty); + types.push_back(Type::Int8Ty); + size_t s = 16; // stack frame size in bits +#endif + + // Bind argument values in CEnv + vector args; + const_iterator p = prot()->begin(); + size_t i = 0; + for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++p, ++i) { + AType* t = protT->at(i)->as(); + const Type* lt = llType(t); + THROW_IF(!lt, loc, "untyped parameter\n"); + cenv.def((*p)->as(), *p, t, &*a); +#ifdef EXPLICIT_STACK_FRAMES + types.push_back(lt); + s += std::max(lt->getPrimitiveSizeInBits(), unsigned(8)); +#endif + } + + +#ifdef EXPLICIT_STACK_FRAMES + IRBuilder<> builder = llEngine(cenv)->builder; + + // Scan out definitions + for (size_t i = 0; i < size(); ++i) { + ADef* def = at(i)->to(); + if (def) { + const Type* lt = llType(cenv.type(def->at(2))); + THROW_IF(!lt, loc, "untyped definition\n"); + types.push_back(lt); + s += std::max(lt->getPrimitiveSizeInBits(), unsigned(8)); + } + } + + // Create stack frame + StructType* frameT = StructType::get(types, false); + Value* tag = ConstantInt::get(Type::Int8Ty, GC::TAG_FRAME); + Value* frameSize = ConstantInt::get(Type::Int32Ty, s / 8); + Value* frame = builder.CreateCall2(llVal(cenv.alloc), frameSize, tag, "frame"); + Value* framePtr = builder.CreateBitCast(frame, PointerType::get(frameT, 0)); + + // Bind parameter values in stack frame + i = 2; + for (Function::arg_iterator a = f->arg_begin(); a != f->arg_end(); ++a, ++i) { + Value* v = builder.CreateStructGEP(framePtr, i, "arg"); + builder.CreateStore(&*a, v); + } +#endif + + // Write function body + try { + // Define value first for recursion + cenv.precompile(this, f); + impls.push_back(make_pair(thisType, f)); + CValue retVal = NULL; + for (size_t i = 2; i < size(); ++i) + retVal = cenv.compile(at(i)); + cenv.engine()->finishFunction(cenv, f, cenv.type(at(size()-1)), retVal); + } catch (Error& e) { + f->eraseFromParent(); // Error reading body, remove function + cenv.pop(); + throw e; + } + cenv.tsubst = oldSubst; + cenv.pop(); +} + +CValue +AFn::compile(CEnv& cenv) +{ + return NULL; +} + +void +ACall::lift(CEnv& cenv) +{ + AFn* c = cenv.tenv.resolve(at(0))->to(); + AType argsT(loc, NULL); + + // Lift arguments + for (size_t i = 1; i < size(); ++i) { + at(i)->lift(cenv); + argsT.push_back(cenv.type(at(i))); + } + + if (!c) return; // Primitive + + if (c->prot()->size() < size() - 1) + throw Error(loc, (format("too many arguments to function `%1%'") % at(0)->str()).str()); + if (c->prot()->size() > size() - 1) + throw Error(loc, (format("too few arguments to function `%1%'") % at(0)->str()).str()); + + c->liftCall(cenv, argsT); // Lift called closure +} + +CValue +ACall::compile(CEnv& cenv) +{ + AFn* c = cenv.tenv.resolve(at(0))->to(); + + if (!c) return NULL; // Primitive + + AType protT(loc, NULL); + vector types; + for (size_t i = 1; i < size(); ++i) { + protT.push_back(cenv.type(at(i))); + types.push_back(llType(cenv.type(at(i)))); + } + + TEnv::GenericTypes::const_iterator gt = cenv.tenv.genericTypes.find(c); + assert(gt != cenv.tenv.genericTypes.end()); + AType fnT(loc, cenv.penv.sym("Fn"), &protT, cenv.type(this), 0); + Function* f = (Function*)c->impls.find(&fnT); + THROW_IF(!f, loc, (format("callee failed to compile for type %1%") % fnT.str()).str()); + + vector params(size() - 1); + for (size_t i = 0; i < types.size(); ++i) + params[i] = llVal(cenv.compile(at(i+1))); + + return llEngine(cenv)->builder.CreateCall(f, params.begin(), params.end()); +} + +void +ADef::lift(CEnv& cenv) +{ + // Define stub first for recursion + cenv.def(sym(), at(2), cenv.type(at(2)), NULL); + AFn* c = at(2)->to(); + if (c) + c->name = sym()->str(); + at(2)->lift(cenv); +} + +CValue +ADef::compile(CEnv& cenv) +{ + // Define stub first for recursion + cenv.def(sym(), at(2), cenv.type(at(2)), NULL); + CValue val = cenv.compile(at(size() - 1)); + cenv.vals.def(sym(), val); + return val; +} + +CValue +AIf::compile(CEnv& cenv) +{ + typedef vector< pair > Branches; + Function* parent = llEngine(cenv)->builder.GetInsertBlock()->getParent(); + BasicBlock* mergeBB = BasicBlock::Create("endif"); + BasicBlock* nextBB = NULL; + Branches branches; + for (size_t i = 1; i < size() - 1; i += 2) { + Value* condV = llVal(cenv.compile(at(i))); + BasicBlock* thenBB = BasicBlock::Create((format("then%1%") % ((i+1)/2)).str()); + + nextBB = BasicBlock::Create((format("else%1%") % ((i+1)/2)).str()); + + llEngine(cenv)->builder.CreateCondBr(condV, thenBB, nextBB); + + // Emit then block for this condition + parent->getBasicBlockList().push_back(thenBB); + llEngine(cenv)->builder.SetInsertPoint(thenBB); + Value* thenV = llVal(cenv.compile(at(i+1))); + llEngine(cenv)->builder.CreateBr(mergeBB); + branches.push_back(make_pair(thenV, llEngine(cenv)->builder.GetInsertBlock())); + + parent->getBasicBlockList().push_back(nextBB); + llEngine(cenv)->builder.SetInsertPoint(nextBB); + } + + // Emit final else block + llEngine(cenv)->builder.SetInsertPoint(nextBB); + Value* elseV = llVal(cenv.compile(at(size() - 1))); + llEngine(cenv)->builder.CreateBr(mergeBB); + branches.push_back(make_pair(elseV, llEngine(cenv)->builder.GetInsertBlock())); + + // Emit merge block (Phi node) + parent->getBasicBlockList().push_back(mergeBB); + llEngine(cenv)->builder.SetInsertPoint(mergeBB); + PHINode* pn = llEngine(cenv)->builder.CreatePHI(llType(cenv.type(this)), "ifval"); + + FOREACH(Branches::iterator, i, branches) + pn->addIncoming(i->first, i->second); + + return pn; +} + +CValue +APrimitive::compile(CEnv& cenv) +{ + Value* a = llVal(cenv.compile(at(1))); + Value* b = llVal(cenv.compile(at(2))); + bool isFloat = cenv.type(at(1))->str() == "Float"; + const string n = at(0)->to()->str(); + + // Binary arithmetic operations + Instruction::BinaryOps op = (Instruction::BinaryOps)0; + if (n == "+") op = Instruction::Add; + if (n == "-") op = Instruction::Sub; + if (n == "*") op = Instruction::Mul; + if (n == "and") op = Instruction::And; + if (n == "or") op = Instruction::Or; + if (n == "xor") op = Instruction::Xor; + if (n == "/") op = isFloat ? Instruction::FDiv : Instruction::SDiv; + if (n == "%") op = isFloat ? Instruction::FRem : Instruction::SRem; + if (op != 0) { + Value* val = llEngine(cenv)->builder.CreateBinOp(op, a, b); + for (size_t i = 3; i < size(); ++i) + val = llEngine(cenv)->builder.CreateBinOp(op, val, llVal(cenv.compile(at(i)))); + return val; + } + + // Comparison operations + CmpInst::Predicate pred = (CmpInst::Predicate)0; + if (n == "=") pred = isFloat ? CmpInst::FCMP_OEQ : CmpInst::ICMP_EQ ; + if (n == "!=") pred = isFloat ? CmpInst::FCMP_ONE : CmpInst::ICMP_NE ; + if (n == ">") pred = isFloat ? CmpInst::FCMP_OGT : CmpInst::ICMP_SGT; + if (n == ">=") pred = isFloat ? CmpInst::FCMP_OGE : CmpInst::ICMP_SGE; + if (n == "<") pred = isFloat ? CmpInst::FCMP_OLT : CmpInst::ICMP_SLT; + if (n == "<=") pred = isFloat ? CmpInst::FCMP_OLE : CmpInst::ICMP_SLE; + if (pred != 0) { + if (isFloat) + return llEngine(cenv)->builder.CreateFCmp(pred, a, b); + else + return llEngine(cenv)->builder.CreateICmp(pred, a, b); + } + + throw Error(loc, "unknown primitive"); +} + -- cgit v1.2.1