# HG changeset patch # User Tomas Lindquist Olsen # Date 1233647697 -3600 # Node ID 545f54041d9178841ebb5ffb3607d2576051758d # Parent c76f74d09fb159b3e4cf7c2d7467667e3c619696 Implemented proper support for naked asm using llvm module level asm. Still not 100% complete, but already 1000 times better that what we had before. Don's BignumX86 implementation from Tango (when turned into a standalone unittest) seems to fully work with no changes, and great performance :) Fixed align N; in asm blocks. Fixed inreg parameter passing on x86 for ref/out params. Removed support for lazy initialization of function local static variables, I have no idea why I ever implemented this, it's not in the D spec, and DMD doesn't support it :P Some of the global variable related changes might cause minor regressions, but they should be easily fixable. diff -r c76f74d09fb1 -r 545f54041d91 dmd/declaration.c --- a/dmd/declaration.c Mon Feb 02 02:35:44 2009 +0100 +++ b/dmd/declaration.c Tue Feb 03 08:54:57 2009 +0100 @@ -625,6 +625,7 @@ // LDC anonDecl = NULL; offset2 = 0; + nakedUse = false; } Dsymbol *VarDeclaration::syntaxCopy(Dsymbol *s) diff -r c76f74d09fb1 -r 545f54041d91 dmd/declaration.h --- a/dmd/declaration.h Mon Feb 02 02:35:44 2009 +0100 +++ b/dmd/declaration.h Tue Feb 03 08:54:57 2009 +0100 @@ -274,6 +274,7 @@ // LDC AnonDeclaration* anonDecl; unsigned offset2; + bool nakedUse; }; /**************************************************************/ diff -r c76f74d09fb1 -r 545f54041d91 dmd/mars.c --- a/dmd/mars.c Mon Feb 02 02:35:44 2009 +0100 +++ b/dmd/mars.c Tue Feb 03 08:54:57 2009 +0100 @@ -888,7 +888,7 @@ global.params.cpu = ARCHthumb; } else { - assert(0 && "Invalid arch"); + error("invalid cpu architecture specified: %s", global.params.llvmArch); } assert(global.params.cpu != ARCHinvalid); diff -r c76f74d09fb1 -r 545f54041d91 dmd/statement.h --- a/dmd/statement.h Mon Feb 02 02:35:44 2009 +0100 +++ b/dmd/statement.h Tue Feb 03 08:54:57 2009 +0100 @@ -161,6 +161,9 @@ // Back end virtual void toIR(IRState *irs); + // LDC + virtual void toNakedIR(IRState *irs); + // Avoid dynamic_cast virtual DeclarationStatement *isDeclarationStatement() { return NULL; } virtual CompoundStatement *isCompoundStatement() { return NULL; } @@ -185,6 +188,9 @@ Statement *inlineScan(InlineScanState *iss); void toIR(IRState *irs); + + // LDC + void toNakedIR(IRState *irs); }; struct CompileStatement : Statement @@ -234,6 +240,9 @@ virtual void toIR(IRState *irs); + // LDC + virtual void toNakedIR(IRState *irs); + virtual CompoundStatement *isCompoundStatement() { return this; } }; @@ -844,6 +853,7 @@ // LDC bool asmLabel; // for labels inside inline assembler + void toNakedIR(IRState *irs); }; struct LabelDsymbol : Dsymbol @@ -876,6 +886,8 @@ // LDC // non-zero if this is a branch, contains the target labels identifier Identifier* isBranchToLabel; + + void toNakedIR(IRState *irs); }; struct AsmBlockStatement : CompoundStatement @@ -892,6 +904,7 @@ AsmBlockStatement *isAsmBlockStatement() { return this; } void toIR(IRState *irs); + void toNakedIR(IRState *irs); }; #endif /* DMD_STATEMENT_H */ diff -r c76f74d09fb1 -r 545f54041d91 gen/asm-x86-32.h --- a/gen/asm-x86-32.h Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/asm-x86-32.h Tue Feb 03 08:54:57 2009 +0100 @@ -1409,21 +1409,66 @@ } void addOperand(const char * fmt, AsmArgType type, Expression * e, AsmCode * asmcode, AsmArgMode mode = Mode_Input) { - insnTemplate->writestring((char*) fmt); - insnTemplate->printf("<<%s%d>>", (mode==Mode_Input)?"in":"out", asmcode->args.dim); - asmcode->args.push( new AsmArg(type, e, mode) ); + if (sc->func->naked) + { + switch(type) + { + case Arg_Integer: + if (e->type->isunsigned()) + insnTemplate->printf("$%llu", e->toUInteger()); + else + insnTemplate->printf("$%lld", e->toInteger()); + break; + + case Arg_Pointer: + stmt->error("unsupported pointer reference to '%s' in naked asm", e->toChars()); + break; + + case Arg_Memory: + if (e->op == TOKvar) + { + VarExp* v = (VarExp*)e; + if (VarDeclaration* vd = v->var->isVarDeclaration()) + { + if (!vd->isDataseg()) + { + stmt->error("only global variables can be referenced by identifier in naked asm"); + break; + } + + // print out the mangle + insnTemplate->writestring(vd->mangle()); + vd->nakedUse = true; + break; + } + } + stmt->error("unsupported memory reference to '%s' in naked asm", e->toChars()); + break; + + default: + assert(0 && "asm unsupported arg"); + break; + } + } + else + { + insnTemplate->writestring((char*) fmt); + insnTemplate->printf("<<%s%d>>", (mode==Mode_Input)?"in":"out", asmcode->args.dim); + asmcode->args.push( new AsmArg(type, e, mode) ); + } } void addOperand2(const char * fmtpre, const char * fmtpost, AsmArgType type, Expression * e, AsmCode * asmcode, AsmArgMode mode = Mode_Input) { - insnTemplate->writestring((char*) fmtpre); - insnTemplate->printf("<<%s%d>>", (mode==Mode_Input)?"in":"out", asmcode->args.dim); - insnTemplate->writestring((char*) fmtpost); - asmcode->args.push( new AsmArg(type, e, mode) ); + assert(!sc->func->naked); + insnTemplate->writestring((char*) fmtpre); + insnTemplate->printf("<<%s%d>>", (mode==Mode_Input)?"in":"out", asmcode->args.dim); + insnTemplate->writestring((char*) fmtpost); + asmcode->args.push( new AsmArg(type, e, mode) ); } void addLabel(char* id) { - insnTemplate->writestring(sc->func->mangle()); - insnTemplate->writestring("_"); - insnTemplate->writestring(id); + insnTemplate->writestring(sc->func->mangle()); + insnTemplate->writestring("_"); + insnTemplate->writestring(id); } /* Determines whether the operand is a register, memory reference @@ -1916,9 +1961,12 @@ insnTemplate->writebyte('*'); use_star = false; } + + if (!sc->func->naked) { // no addrexp in naked asm please :) Type* tt = e->type->pointerTo(); e = new AddrExp(0, e); e->type = tt; + } addOperand(fmt, Arg_Memory, e, asmcode, mode); } @@ -2515,9 +2563,9 @@ // parse primary: DMD allows 'MyAlign' (const int) but not '2+2' // GAS is padding with NOPs last time I checked. Expression * e = parseAsmExp()->optimize(WANTvalue | WANTinterpret); - integer_t align = e->toInteger(); + uinteger_t align = e->toUInteger(); - if (align & align - 1 == 0) { + if ((align & (align - 1)) == 0) { //FIXME: This printf is not portable. The use of `align` varies from system to system; // on i386 using a.out, .align `n` will align on a 2^`n` boundary instead of an `n` boundary #ifdef HAVE_GAS_BALIGN_AND_P2ALIGN @@ -2526,7 +2574,7 @@ insnTemplate->printf(".align\t%u", (unsigned) align); #endif } else { - stmt->error("alignment must be a power of 2"); + stmt->error("alignment must be a power of 2, not %u", (unsigned) align); } setAsmCode(); diff -r c76f74d09fb1 -r 545f54041d91 gen/asm-x86-64.h --- a/gen/asm-x86-64.h Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/asm-x86-64.h Tue Feb 03 08:54:57 2009 +0100 @@ -1529,21 +1529,66 @@ } void addOperand(const char * fmt, AsmArgType type, Expression * e, AsmCode * asmcode, AsmArgMode mode = Mode_Input) { - insnTemplate->writestring((char*) fmt); - insnTemplate->printf("<<%s%d>>", (mode==Mode_Input)?"in":"out", asmcode->args.dim); - asmcode->args.push( new AsmArg(type, e, mode) ); + if (sc->func->naked) + { + switch(type) + { + case Arg_Integer: + if (e->type->isunsigned()) + insnTemplate->printf("$%llu", e->toUInteger()); + else + insnTemplate->printf("$%lld", e->toInteger()); + break; + + case Arg_Pointer: + stmt->error("unsupported pointer reference to '%s' in naked asm", e->toChars()); + break; + + case Arg_Memory: + if (e->op == TOKvar) + { + VarExp* v = (VarExp*)e; + if (VarDeclaration* vd = v->var->isVarDeclaration()) + { + if (!vd->isDataseg()) + { + stmt->error("only global variables can be referenced by identifier in naked asm"); + break; + } + + // print out the mangle + insnTemplate->writestring(vd->mangle()); + vd->nakedUse = true; + break; + } + } + stmt->error("unsupported memory reference to '%s' in naked asm", e->toChars()); + break; + + default: + assert(0 && "asm unsupported arg"); + break; + } + } + else + { + insnTemplate->writestring((char*) fmt); + insnTemplate->printf("<<%s%d>>", (mode==Mode_Input)?"in":"out", asmcode->args.dim); + asmcode->args.push( new AsmArg(type, e, mode) ); + } } void addOperand2(const char * fmtpre, const char * fmtpost, AsmArgType type, Expression * e, AsmCode * asmcode, AsmArgMode mode = Mode_Input) { - insnTemplate->writestring((char*) fmtpre); - insnTemplate->printf("<<%s%d>>", (mode==Mode_Input)?"in":"out", asmcode->args.dim); - insnTemplate->writestring((char*) fmtpost); - asmcode->args.push( new AsmArg(type, e, mode) ); + assert(!sc->func->naked); + insnTemplate->writestring((char*) fmtpre); + insnTemplate->printf("<<%s%d>>", (mode==Mode_Input)?"in":"out", asmcode->args.dim); + insnTemplate->writestring((char*) fmtpost); + asmcode->args.push( new AsmArg(type, e, mode) ); } void addLabel(char* id) { - insnTemplate->writestring(sc->func->mangle()); - insnTemplate->writestring("_"); - insnTemplate->writestring(id); + insnTemplate->writestring(sc->func->mangle()); + insnTemplate->writestring("_"); + insnTemplate->writestring(id); } /* Determines whether the operand is a register, memory reference @@ -2037,9 +2082,12 @@ insnTemplate->writebyte('*'); use_star = false; } + + if (!sc->func->naked) { // no addrexp in naked asm please :) Type* tt = e->type->pointerTo(); e = new AddrExp(0, e); e->type = tt; + } addOperand(fmt, Arg_Memory, e, asmcode, mode); } @@ -2636,9 +2684,9 @@ // parse primary: DMD allows 'MyAlign' (const int) but not '2+2' // GAS is padding with NOPs last time I checked. Expression * e = parseAsmExp()->optimize(WANTvalue | WANTinterpret); - integer_t align = e->toInteger(); + uinteger_t align = e->toUInteger(); - if (align & align - 1 == 0) { + if ((align & (align - 1)) == 0) { //FIXME: This printf is not portable. The use of `align` varies from system to system; // on i386 using a.out, .align `n` will align on a 2^`n` boundary instead of an `n` boundary #ifdef HAVE_GAS_BALIGN_AND_P2ALIGN @@ -2647,7 +2695,7 @@ insnTemplate->printf(".align\t%u", (unsigned) align); #endif } else { - stmt->error("alignment must be a power of 2"); + stmt->error("alignment must be a power of 2, not %u", (unsigned) align); } setAsmCode(); diff -r c76f74d09fb1 -r 545f54041d91 gen/asmstmt.cpp --- a/gen/asmstmt.cpp Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/asmstmt.cpp Tue Feb 03 08:54:57 2009 +0100 @@ -15,7 +15,6 @@ #include #include #include -#include #include //#include "d-lang.h" @@ -157,6 +156,8 @@ if (err) fatal(); + //puts(toChars()); + sc->func->inlineAsm = 1; sc->func->inlineStatus = ILSno; // %% not sure // %% need to set DECL_UNINLINABLE too? @@ -699,3 +700,35 @@ return CompoundStatement::semantic(sc); } + +////////////////////////////////////////////////////////////////////////////// + +void AsmStatement::toNakedIR(IRState *p) +{ + Logger::println("AsmStatement::toNakedIR(): %s", loc.toChars()); + LOG_SCOPE; + + // is there code? + if (!asmcode) + return; + AsmCode * code = (AsmCode *) asmcode; + + // build asm stmt + std::ostringstream& asmstr = p->nakedAsm; + asmstr << "\t"; + asmstr.write(code->insnTemplate, code->insnTemplateLen); + asmstr << std::endl; +} + +void AsmBlockStatement::toNakedIR(IRState *p) +{ + Logger::println("AsmBlockStatement::toNakedIR(): %s", loc.toChars()); + LOG_SCOPE; + + // do asm statements + for (unsigned i=0; idim; i++) + { + Statement* s = (Statement*)statements->data[i]; + if (s) s->toNakedIR(p); + } +} diff -r c76f74d09fb1 -r 545f54041d91 gen/classes.cpp --- a/gen/classes.cpp Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/classes.cpp Tue Feb 03 08:54:57 2009 +0100 @@ -1,4 +1,3 @@ -#include #include "gen/llvm.h" #include "mtype.h" diff -r c76f74d09fb1 -r 545f54041d91 gen/functions.cpp --- a/gen/functions.cpp Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/functions.cpp Tue Feb 03 08:54:57 2009 +0100 @@ -209,12 +209,16 @@ { Type* t = arg->type->toBasetype(); - // 32bit ints, pointers, classes, static arrays and AAs + // 32bit ints, pointers, classes, static arrays, AAs, ref and out params // are candidate for being passed in EAX - if ((arg->storageClass & STCin) && - ((t->isscalar() && !t->isfloating()) || + if ( + (arg->storageClass & (STCref|STCout)) + || + ((arg->storageClass & STCin) && + ((t->isscalar() && !t->isfloating()) || t->ty == Tclass || t->ty == Tsarray || t->ty == Taarray) && - (t->size() <= PTRSIZE)) + (t->size() <= PTRSIZE)) + ) { arg->llvmAttrs |= llvm::Attribute::InReg; assert((f->thisAttrs & llvm::Attribute::InReg) == 0 && "can't have two inreg args!"); @@ -618,7 +622,7 @@ ////////////////////////////////////////////////////////////////////////////////////////// -void DtoDefineFunc(FuncDeclaration* fd) +void DtoDefineFunction(FuncDeclaration* fd) { if (fd->ir.defined) return; fd->ir.defined = true; @@ -628,6 +632,13 @@ Logger::println("DtoDefineFunc(%s): %s", fd->toPrettyChars(), fd->loc.toChars()); LOG_SCOPE; + // if this function is naked, we take over right away! no standard processing! + if (fd->naked) + { + DtoDefineNakedFunction(fd); + return; + } + // debug info if (global.params.symdebug) { Module* mo = fd->getModule(); @@ -684,8 +695,7 @@ // this hack makes sure the frame pointer elimination optimization is disabled. // this this eliminates a bunch of inline asm related issues. - // naked must always eliminate the framepointer however... - if (fd->inlineAsm && !fd->naked) + if (fd->inlineAsm) { // emit a call to llvm_eh_unwind_init LLFunction* hack = GET_INTRINSIC_DECL(eh_unwind_init); diff -r c76f74d09fb1 -r 545f54041d91 gen/functions.h --- a/gen/functions.h Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/functions.h Tue Feb 03 08:54:57 2009 +0100 @@ -8,7 +8,8 @@ void DtoResolveFunction(FuncDeclaration* fdecl); void DtoDeclareFunction(FuncDeclaration* fdecl); -void DtoDefineFunc(FuncDeclaration* fd); +void DtoDefineFunction(FuncDeclaration* fd); +void DtoDefineNakedFunction(FuncDeclaration* fd); DValue* DtoArgument(Argument* fnarg, Expression* argexp); void DtoVariadicArgument(Expression* argexp, LLValue* dst); diff -r c76f74d09fb1 -r 545f54041d91 gen/irstate.h --- a/gen/irstate.h Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/irstate.h Tue Feb 03 08:54:57 2009 +0100 @@ -3,6 +3,7 @@ #include #include +#include #include "root.h" #include "aggregate.h" @@ -200,10 +201,12 @@ // for inline asm IRAsmBlock* asmBlock; + std::ostringstream nakedAsm; + + // 'used' array solely for keeping a reference to globals + std::vector usedArray; // dwarf dbg stuff - // 'used' array solely for keeping a reference to globals - std::vector usedArray; LLGlobalVariable* dwarfCUs; LLGlobalVariable* dwarfSPs; LLGlobalVariable* dwarfGVs; diff -r c76f74d09fb1 -r 545f54041d91 gen/llvmhelpers.cpp --- a/gen/llvmhelpers.cpp Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/llvmhelpers.cpp Tue Feb 03 08:54:57 2009 +0100 @@ -838,36 +838,6 @@ /****************************************************************************************/ /*//////////////////////////////////////////////////////////////////////////////////////// -// LAZY STATIC INIT HELPER -////////////////////////////////////////////////////////////////////////////////////////*/ - -void DtoLazyStaticInit(bool istempl, LLValue* gvar, Initializer* init, Type* t) -{ - // create a flag to make sure initialization only happens once - llvm::GlobalValue::LinkageTypes gflaglink = istempl ? TEMPLATE_LINKAGE_TYPE : llvm::GlobalValue::InternalLinkage; - std::string gflagname(gvar->getName()); - gflagname.append("__initflag"); - llvm::GlobalVariable* gflag = new llvm::GlobalVariable(LLType::Int1Ty,false,gflaglink,DtoConstBool(false),gflagname,gIR->module); - - // check flag and do init if not already done - llvm::BasicBlock* oldend = gIR->scopeend(); - llvm::BasicBlock* initbb = llvm::BasicBlock::Create("ifnotinit",gIR->topfunc(),oldend); - llvm::BasicBlock* endinitbb = llvm::BasicBlock::Create("ifnotinitend",gIR->topfunc(),oldend); - LLValue* cond = gIR->ir->CreateICmpEQ(gIR->ir->CreateLoad(gflag,"tmp"),DtoConstBool(false)); - gIR->ir->CreateCondBr(cond, initbb, endinitbb); - gIR->scope() = IRScope(initbb,endinitbb); - DValue* ie = DtoInitializer(gvar, init); - - DVarValue dst(t, gvar); - DtoAssign(init->loc, &dst, ie); - - gIR->ir->CreateStore(DtoConstBool(true), gflag); - gIR->ir->CreateBr(endinitbb); - gIR->scope() = IRScope(endinitbb,oldend); -} - -/****************************************************************************************/ -/*//////////////////////////////////////////////////////////////////////////////////////// // PROCESSING QUEUE HELPERS ////////////////////////////////////////////////////////////////////////////////////////*/ @@ -946,7 +916,7 @@ DtoDefineClass(cd); } else if (FuncDeclaration* fd = dsym->isFuncDeclaration()) { - DtoDefineFunc(fd); + DtoDefineFunction(fd); } else if (TypeInfoDeclaration* fd = dsym->isTypeInfoDeclaration()) { DtoDefineTypeInfo(fd); @@ -967,36 +937,10 @@ Logger::println("DtoConstInitGlobal(%s) @ %s", vd->toChars(), vd->locToChars()); LOG_SCOPE; - // if the variable is a function local static variable with a runtime initializer - // we must do lazy initialization, which involves a boolean flag to make sure it happens only once - // FIXME: I don't think it's thread safe ... - - bool doLazyInit = false; Dsymbol* par = vd->toParent(); - if (par && par->isFuncDeclaration() && vd->init) - { - if (ExpInitializer* einit = vd->init->isExpInitializer()) - { - if (!einit->exp->isConst()) - { - // mark as needing lazy now - doLazyInit = true; - } - } - } - - // if we do lazy init, we start out with an undefined initializer - LLConstant* initVal; - if (doLazyInit) - { - initVal = llvm::UndefValue::get(DtoType(vd->type)); - } - // otherwise we build it - else - { - initVal = DtoConstInitializer(vd->loc, vd->type, vd->init); - } + // build the initializer + LLConstant* initVal = DtoConstInitializer(vd->loc, vd->type, vd->init); // set the initializer if appropriate IrGlobal* glob = vd->ir.irGlobal; @@ -1035,9 +979,6 @@ gIR->usedArray.push_back(llvm::ConstantExpr::getBitCast(gv, getVoidPtrType())); } } - - if (doLazyInit) - DtoLazyStaticInit(istempl, gvar, vd->init, vd->type); } ////////////////////////////////////////////////////////////////////////////////////////// diff -r c76f74d09fb1 -r 545f54041d91 gen/llvmhelpers.h --- a/gen/llvmhelpers.h Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/llvmhelpers.h Tue Feb 03 08:54:57 2009 +0100 @@ -64,9 +64,6 @@ // is template instance check bool DtoIsTemplateInstance(Dsymbol* s); -// generates lazy static initialization code for a global variable -void DtoLazyStaticInit(bool istempl, LLValue* gvar, Initializer* init, Type* t); - // these are all basically drivers for the codegeneration called by the main loop void DtoResolveDsymbol(Dsymbol* dsym); void DtoDeclareDsymbol(Dsymbol* dsym); diff -r c76f74d09fb1 -r 545f54041d91 gen/naked.cpp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gen/naked.cpp Tue Feb 03 08:54:57 2009 +0100 @@ -0,0 +1,140 @@ +#include "gen/llvm.h" + +#include "expression.h" +#include "statement.h" +#include "declaration.h" + +#include + +#include "gen/logger.h" +#include "gen/irstate.h" +#include "gen/llvmhelpers.h" + +////////////////////////////////////////////////////////////////////////////////////////// + +void Statement::toNakedIR(IRState *p) +{ + error("not allowed in naked function"); +} + +////////////////////////////////////////////////////////////////////////////////////////// + +void CompoundStatement::toNakedIR(IRState *p) +{ + Logger::println("CompoundStatement::toNakedIR(): %s", loc.toChars()); + LOG_SCOPE; + + if (statements) + for (unsigned i = 0; i < statements->dim; i++) + { + Statement* s = (Statement*)statements->data[i]; + if (s) s->toNakedIR(p); + } +} + +////////////////////////////////////////////////////////////////////////////////////////// + +void ExpStatement::toNakedIR(IRState *p) +{ + Logger::println("ExpStatement::toNakedIR(): %s", loc.toChars()); + LOG_SCOPE; + + // only expstmt supported in declarations + if (exp->op != TOKdeclaration) + { + Statement::toNakedIR(p); + return; + } + + DeclarationExp* d = (DeclarationExp*)exp; + VarDeclaration* vd = d->declaration->isVarDeclaration(); + FuncDeclaration* fd = d->declaration->isFuncDeclaration(); + EnumDeclaration* ed = d->declaration->isEnumDeclaration(); + + // and only static variable/function declaration + // no locals or nested stuffies! + if (!vd && !fd && !ed) + { + Statement::toNakedIR(p); + return; + } + else if (vd && !vd->isDataseg()) + { + error("non-static variable '%s' not allowed in naked function", vd->toChars()); + return; + } + else if (fd && !fd->isStatic()) + { + error("non-static nested function '%s' not allowed in naked function", fd->toChars()); + return; + } + // enum decls should always be safe + + // make sure the symbols gets processed + d->declaration->toObjFile(0); +} + +////////////////////////////////////////////////////////////////////////////////////////// + +void LabelStatement::toNakedIR(IRState *p) +{ + Logger::println("LabelStatement::toNakedIR(): %s", loc.toChars()); + LOG_SCOPE; + + p->nakedAsm << p->func()->decl->mangle() << "_" << ident->toChars() << ":"; + + if (statement) + statement->toNakedIR(p); +} + +////////////////////////////////////////////////////////////////////////////////////////// + +void DtoDefineNakedFunction(FuncDeclaration* fd) +{ + Logger::println("DtoDefineNakedFunction(%s)", fd->mangle()); + LOG_SCOPE; + + assert(fd->ir.irFunc); + gIR->functions.push_back(fd->ir.irFunc); + + // we need to do special processing on the body, since we only want + // to allow actual inline asm blocks to reach the final asm output + + std::ostringstream& asmstr = gIR->nakedAsm; + + // build function header + + // REALLY FIXME: this is most likely extremely platform dependent + + const char* mangle = fd->mangle(); + const char* linkage = "globl"; + std::string section = "text"; + unsigned align = 16; + + std::ostringstream tmpstr; + + if (DtoIsTemplateInstance(fd)) + { + linkage = "weak"; + tmpstr << "section\t.gnu.linkonce.t." << mangle << ",\"ax\",@progbits"; + section = tmpstr.str(); + } + + asmstr << "\t." << section << std::endl; + asmstr << "\t.align\t" << align << std::endl; + asmstr << "\t." << linkage << "\t" << mangle << std::endl; + asmstr << "\t.type\t" << mangle << ",@function" << std::endl; + asmstr << mangle << ":" << std::endl; + + // emit body + fd->fbody->toNakedIR(gIR); + + // emit size after body + // why? dunno, llvm seems to do it by default .. + asmstr << "\t.size\t" << mangle << ", .-" << mangle << std::endl << std::endl; + + gIR->module->appendModuleInlineAsm(asmstr.str()); + asmstr.str(""); + + gIR->functions.pop_back(); +} diff -r c76f74d09fb1 -r 545f54041d91 gen/statements.cpp --- a/gen/statements.cpp Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/statements.cpp Tue Feb 03 08:54:57 2009 +0100 @@ -2,7 +2,6 @@ #include #include -#include #include #include diff -r c76f74d09fb1 -r 545f54041d91 gen/toir.cpp --- a/gen/toir.cpp Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/toir.cpp Tue Feb 03 08:54:57 2009 +0100 @@ -8,7 +8,6 @@ #include #include -#include #include #include @@ -205,6 +204,7 @@ { Logger::print("VarExp::toConstElem: %s | %s\n", toChars(), type->toChars()); LOG_SCOPE; + if (StaticStructInitDeclaration* sdecl = var->isStaticStructInitDeclaration()) { // this seems to be the static initialiser for structs @@ -216,7 +216,8 @@ assert(ts->sym->ir.irStruct->constInit); return ts->sym->ir.irStruct->constInit; } - else if (TypeInfoDeclaration* ti = var->isTypeInfoDeclaration()) + + if (TypeInfoDeclaration* ti = var->isTypeInfoDeclaration()) { const LLType* vartype = DtoType(type); LLConstant* m = DtoTypeInfoOf(ti->tinfo, false); @@ -224,15 +225,17 @@ m = llvm::ConstantExpr::getBitCast(m, vartype); return m; } - else if (VarDeclaration* vd = var->isVarDeclaration()) + + VarDeclaration* vd = var->isVarDeclaration(); + if (vd && vd->isConst() && vd->init) { // return the initializer - assert(vd->init); return DtoConstInitializer(loc, type, vd->init); } + // fail - assert(0 && "Unsupported const VarExp kind"); - return NULL; + error("non-constant expression %s", toChars()); + return llvm::UndefValue::get(DtoType(type)); } ////////////////////////////////////////////////////////////////////////////////////////// diff -r c76f74d09fb1 -r 545f54041d91 gen/tollvm.cpp --- a/gen/tollvm.cpp Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/tollvm.cpp Tue Feb 03 08:54:57 2009 +0100 @@ -294,8 +294,9 @@ if (fdecl->llvmInternal == LLVMintrinsic) return llvm::GlobalValue::ExternalLinkage; // template instances should have weak linkage - // but only if there's a body, otherwise we make it external - else if (DtoIsTemplateInstance(fdecl) && fdecl->fbody) + // but only if there's a body, and it's not naked + // otherwise we make it external + else if (DtoIsTemplateInstance(fdecl) && fdecl->fbody && !fdecl->naked) return TEMPLATE_LINKAGE_TYPE; // extern(C) functions are always external else if (ft->linkage == LINKc) diff -r c76f74d09fb1 -r 545f54041d91 gen/toobj.cpp --- a/gen/toobj.cpp Mon Feb 02 02:35:44 2009 +0100 +++ b/gen/toobj.cpp Tue Feb 03 08:54:57 2009 +0100 @@ -914,22 +914,13 @@ Logger::println("parent: %s (%s)", parent->toChars(), parent->kind()); - // handle static local variables - bool static_local = false; #if DMDV2 // not sure why this is only needed for d2 bool _isconst = isConst() && init; #else bool _isconst = isConst(); #endif - Dsymbol* par = toParent2(); - if (par && par->isFuncDeclaration()) - { - static_local = true; - if (init && init->isExpInitializer()) { - _isconst = false; - } - } + Logger::println("Creating global variable"); @@ -943,10 +934,12 @@ if (Logger::enabled()) Logger::cout() << *gvar << '\n'; - if (static_local) - DtoConstInitGlobal(this); - else - gIR->constInitList.push_back(this); + // if this global is used from a nested function, this is necessary or + // optimization could potentially remove the global (if it's the only use) + if (nakedUse) + gIR->usedArray.push_back(DtoBitCast(gvar, getVoidPtrType())); + + gIR->constInitList.push_back(this); } else { diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/asm5.d --- a/tests/mini/asm5.d Mon Feb 02 02:35:44 2009 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,30 +0,0 @@ -module tangotests.asm5; - -extern(C) int printf(char*, ...); - -void main() -{ - int i = func(); - printf("%d\n", i); - assert(i == 42); -} - -int func() -{ - version (LLVM_InlineAsm_X86) - { - asm - { - naked; - mov EAX, 42; - ret; - } - } - else version(LLVM_InlineAsm_X86_64) - { - asm - { - movq RAX, 42; - } - } -} diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/naked_asm1.d --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/mini/naked_asm1.d Tue Feb 03 08:54:57 2009 +0100 @@ -0,0 +1,30 @@ +extern(C) int printf(char*, ...); + +void main() +{ + int i = func(); + printf("%d\n", i); + assert(i == 42); +} + +int func() +{ + version (LLVM_InlineAsm_X86) + { + asm + { + naked; + mov EAX, 42; + ret; + } + } + else version(LLVM_InlineAsm_X86_64) + { + asm + { + naked; + movq RAX, 42; + ret; + } + } +} diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/naked_asm2.d --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/mini/naked_asm2.d Tue Feb 03 08:54:57 2009 +0100 @@ -0,0 +1,21 @@ +int foo() +{ + static int fourty2 = 42; + version(X86) + asm + { + naked; + mov EAX, fourty2; + ret; + } + else static assert(0, "todo"); +} + +void main() +{ + int i = foo(); + printf("i == %d\n", i); + assert(i == 42); +} + +extern(C) int printf(char*, ...); diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/naked_asm3.d --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/mini/naked_asm3.d Tue Feb 03 08:54:57 2009 +0100 @@ -0,0 +1,21 @@ +int foo() +{ + enum { fourty2 = 42 } + version(X86) + asm + { + naked; + mov EAX, fourty2; + ret; + } + else static assert(0, "todo"); +} + +void main() +{ + int i = foo(); + printf("i == %d\n", i); + assert(i == 42); +} + +extern(C) int printf(char*, ...); diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/naked_asm4.d --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/mini/naked_asm4.d Tue Feb 03 08:54:57 2009 +0100 @@ -0,0 +1,17 @@ +void foo() +{ + version(X86) + asm + { + naked; + jmp pass; + hlt; +pass: ret; + } + else static assert(0, "todo"); +} + +void main() +{ + foo(); +} diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/naked_asm5.d --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/mini/naked_asm5.d Tue Feb 03 08:54:57 2009 +0100 @@ -0,0 +1,19 @@ +int foo(int op)(int a, int b) +{ + version(X86) + { + const OP = (op == '+') ? "add" : "sub"; + asm { naked; } + mixin("asm{"~OP~" EAX, [ESP+4];}"); + asm { ret 4; } + } + else static assert(0, "todo"); +} + +void main() +{ + int i = foo!('+')(2, 4); + assert(i == 6); + i = foo!('-')(2, 4); + assert(i == 2); +} diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/naked_asm6.d --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/mini/naked_asm6.d Tue Feb 03 08:54:57 2009 +0100 @@ -0,0 +1,18 @@ +extern(C) int printf(char*, ...); + +ulong retval() { + asm { naked; mov EAX, 0xff; mov EDX, 0xaa; ret; } +} + +ulong retval2() { + return (cast(ulong)0xaa << 32) | 0xff; +} + +void main() { + ulong a,b; + a = retval(); + b = retval2(); + printf("%llu\n%llu\n", retval(), retval2()); + assert(a == 0x000000aa000000ff); + assert(a == b); +} diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/structinit4.d --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/mini/structinit4.d Tue Feb 03 08:54:57 2009 +0100 @@ -0,0 +1,18 @@ +// testcase from bug #199 + +struct Color { + uint c; + +} + +struct Vertex { + Color c; +} + +void main() { + Color c = {0xffffffff}; + + auto v = Vertex(c); + + assert(v.c.c == 0xffffffff); // fails in LDC +} diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/structinit5.d --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/mini/structinit5.d Tue Feb 03 08:54:57 2009 +0100 @@ -0,0 +1,11 @@ +struct Vertex { + uint[1] c; +} + +void main() { + uint[1] c = 0xffffffff; + + auto v = Vertex(c); + + assert(v.c[0] == 0xffffffff); // fails in LDC +} diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/templ1.d --- a/tests/mini/templ1.d Mon Feb 02 02:35:44 2009 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -module templ1; - -T func1(T)(T a) -{ - static T b = a; - return b; -} - -void main() -{ -} diff -r c76f74d09fb1 -r 545f54041d91 tests/mini/templ2.d --- a/tests/mini/templ2.d Mon Feb 02 02:35:44 2009 +0100 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -module templ2; -import templ1; - -void main() -{ - func1(1); -}