From: epetrich Date: Tue, 27 Mar 2007 06:02:02 +0000 (+0000) Subject: * src/SDCC.y (declaration_specifiers, function_specifier), X-Git-Url: https://git.gag.com/?a=commitdiff_plain;h=c9d4b0b754284ba05150358a9272e3eafc1242fb;p=fw%2Fsdcc * src/SDCC.y (declaration_specifiers, function_specifier), * support/Util/SDCCerr.c, * support/Util/SDCCerr.h, * src/SDCCsymt.h, * src/SDCCsymt.c (mergeSpec, checkFunction): Parse and validate the inline keyword * src/SDCCmem.c (deallocParms), * src/SDCCast.c: support for function inlining, not quite complete * src/SDCCsymt.c (printTypeChain, printTypeChainRaw): display 'restrict' qualifier git-svn-id: https://sdcc.svn.sourceforge.net/svnroot/sdcc/trunk/sdcc@4719 4a8a32a2-be11-0410-ad9d-d568d2c75423 --- diff --git a/ChangeLog b/ChangeLog index 6fcc7876..36dd588d 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2007-03-27 Erik Petrich + + * src/SDCC.y (declaration_specifiers, function_specifier), + * support/Util/SDCCerr.c, + * support/Util/SDCCerr.h, + * src/SDCCsymt.h, + * src/SDCCsymt.c (mergeSpec, checkFunction): Parse and validate the + inline keyword + * src/SDCCmem.c (deallocParms), + * src/SDCCast.c: support for function inlining, not quite complete + * src/SDCCsymt.c (printTypeChain, printTypeChainRaw): display + 'restrict' qualifier + 2007-03-24 Maarten Brock * src/mcs51/gen.c (saveRegisters, unsaveRegisters): free some bitVects, diff --git a/src/SDCC.y b/src/SDCC.y index 79d6024b..e54f49e3 100644 --- a/src/SDCC.y +++ b/src/SDCC.y @@ -109,7 +109,7 @@ bool uselessDecl = TRUE; %type declaration_list identifier_list %type declarator2_function_attributes while do for critical %type pointer type_specifier_list type_specifier type_name -%type storage_class_specifier struct_or_union_specifier +%type storage_class_specifier struct_or_union_specifier function_specifier %type declaration_specifiers sfr_reg_bit sfr_attributes type_specifier2 %type function_attribute function_attributes enum_specifier %type abstract_declarator abstract_declarator2 unqualified_pointer @@ -520,6 +520,20 @@ declaration_specifiers else $$ = mergeSpec($1,$2, "type_specifier declaration_specifiers"); } + | function_specifier { $$ = $1; } + | function_specifier declaration_specifiers { + /* if the decl $2 is not a specifier */ + /* find the spec and replace it */ + if ( !IS_SPEC($2)) { + sym_link *lnk = $2 ; + while (lnk && !IS_SPEC(lnk->next)) + lnk = lnk->next; + lnk->next = mergeSpec($1,lnk->next, "function_specifier declaration_specifiers - skipped"); + $$ = $2 ; + } + else + $$ = mergeSpec($1,$2, "function_specifier declaration_specifiers"); + } ; init_declarator_list @@ -556,6 +570,13 @@ storage_class_specifier } ; +function_specifier + : INLINE { + $$ = newLink (SPECIFIER) ; + SPEC_INLINE($$) = 1 ; + } + ; + Interrupt_storage : INTERRUPT { $$ = INTNO_UNSPEC ; } | INTERRUPT constant_expr @@ -625,6 +646,10 @@ type_specifier2 $$=newLink(SPECIFIER); SPEC_VOLATILE($$) = 1 ; } + | RESTRICT { + $$=newLink(SPECIFIER); + SPEC_RESTRICT($$) = 1 ; + } | FLOAT { $$=newLink(SPECIFIER); SPEC_NOUN($$) = V_FLOAT; @@ -1156,6 +1181,7 @@ pointer DCL_TSPEC($1) = $2; DCL_PTR_CONST($1) = SPEC_CONST($2); DCL_PTR_VOLATILE($1) = SPEC_VOLATILE($2); + DCL_PTR_RESTRICT($1) = SPEC_RESTRICT($2); } else werror (W_PTR_TYPE_INVALID); @@ -1168,39 +1194,40 @@ pointer } | unqualified_pointer type_specifier_list pointer { - $$ = $1 ; - if (IS_SPEC($2) && DCL_TYPE($3) == UPOINTER) { - DCL_PTR_CONST($1) = SPEC_CONST($2); - DCL_PTR_VOLATILE($1) = SPEC_VOLATILE($2); - switch (SPEC_SCLS($2)) { - case S_XDATA: - DCL_TYPE($3) = FPOINTER; - break; - case S_IDATA: - DCL_TYPE($3) = IPOINTER ; - break; - case S_PDATA: - DCL_TYPE($3) = PPOINTER ; - break; - case S_DATA: - DCL_TYPE($3) = POINTER ; - break; - case S_CODE: - DCL_TYPE($3) = CPOINTER ; - break; - case S_EEPROM: - DCL_TYPE($3) = EEPPOINTER; - break; - default: - // this could be just "constant" - // werror(W_PTR_TYPE_INVALID); - ; - } - } - else - werror (W_PTR_TYPE_INVALID); - $$->next = $3 ; - } + $$ = $1 ; + if (IS_SPEC($2) && DCL_TYPE($3) == UPOINTER) { + DCL_PTR_CONST($1) = SPEC_CONST($2); + DCL_PTR_VOLATILE($1) = SPEC_VOLATILE($2); + DCL_PTR_RESTRICT($1) = SPEC_RESTRICT($2); + switch (SPEC_SCLS($2)) { + case S_XDATA: + DCL_TYPE($3) = FPOINTER; + break; + case S_IDATA: + DCL_TYPE($3) = IPOINTER ; + break; + case S_PDATA: + DCL_TYPE($3) = PPOINTER ; + break; + case S_DATA: + DCL_TYPE($3) = POINTER ; + break; + case S_CODE: + DCL_TYPE($3) = CPOINTER ; + break; + case S_EEPROM: + DCL_TYPE($3) = EEPPOINTER; + break; + default: + // this could be just "constant" + // werror(W_PTR_TYPE_INVALID); + ; + } + } + else + werror (W_PTR_TYPE_INVALID); + $$->next = $3 ; + } ; unqualified_pointer diff --git a/src/SDCCast.c b/src/SDCCast.c index 5103dc5d..d29c998c 100644 --- a/src/SDCCast.c +++ b/src/SDCCast.c @@ -31,6 +31,11 @@ set *astList = NULL; set *operKeyReset = NULL; ast *staticAutos = NULL; int labelKey = 1; +static struct { + int count; /* number of inline functions inserted */ + symbol * retsym; /* variable for inlined function return value */ + symbol * retlab; /* label ending inlined function (virtual return) */ +} inlineState; #define LRVAL(x) x->left->rvalue #define RRVAL(x) x->right->rvalue @@ -5815,6 +5820,7 @@ optimizeCompare (ast * root) noOptimize: return root; } + /*-----------------------------------------------------------------*/ /* addSymToBlock : adds the symbol to the first block we find */ /*-----------------------------------------------------------------*/ @@ -5869,6 +5875,397 @@ DEFSETFUNC (resetParmKey) return 1; } + + +/*------------------------------------------------------------------*/ +/* fixupInlineLabel - change a label in an inlined function so that */ +/* it is always unique no matter how many times */ +/* the function is inlined. */ +/*------------------------------------------------------------------*/ +static void +fixupInlineLabel (symbol * sym) +{ + char name[SDCC_NAME_MAX + 1]; + + SNPRINTF(name, sizeof(name), "%s_%d", sym->name, inlineState.count); + strcpy (sym->name, name); +} + + +/*------------------------------------------------------------------*/ +/* copyAstLoc - copy location information (file, line, block, etc.) */ +/* from one ast node to another */ +/*------------------------------------------------------------------*/ +static void +copyAstLoc (ast * dest, ast * src) +{ + dest->lineno = src->lineno; + dest->filename = src->filename; + dest->level = src->level; + dest->block = src->block; + dest->seqPoint = src->seqPoint; + +} + + +/*-----------------------------------------------------------------*/ +/* fixupInline - perform various fixups on an inline function tree */ +/* to take into account that it is no longer a */ +/* stand-alone function. */ +/*-----------------------------------------------------------------*/ +static void +fixupInline (ast * tree, int level) +{ + tree->block = currBlockno; + + if (IS_AST_OP (tree) && (tree->opval.op == BLOCK)) + { + symbol * decls; + + currBlockno++; + level++; + + /* Add any declared variables back into the symbol table */ + decls = tree->values.sym; + while (decls) + { + decls->level = level; + decls->block = currBlockno; + addSym (SymbolTab, decls, decls->name, decls->level, decls->block, 0); + decls = decls->next; + } + } + + tree->level = level; + + /* Update symbols */ + if (IS_AST_VALUE (tree) && + tree->opval.val->sym) + { + symbol * sym = tree->opval.val->sym; + + sym->level = level; + sym->block = currBlockno; + + /* If the symbol is a label, we need to renumber it */ + if (sym->islbl) + fixupInlineLabel (sym); + } + + /* Update IFX target labels */ + if (tree->type == EX_OP && tree->opval.op == IFX) + { + if (tree->trueLabel) + fixupInlineLabel (tree->trueLabel); + if (tree->falseLabel) + fixupInlineLabel (tree->falseLabel); + } + + /* Replace RETURN with optional assignment and a GOTO to the end */ + /* of the inlined function */ + if (tree->type == EX_OP && tree->opval.op == RETURN) + { + ast * assignTree = NULL; + ast * gotoTree; + + if (inlineState.retsym && tree->right) + { + assignTree = newNode ('=', + newAst_VALUE (symbolVal (inlineState.retsym)), + tree->right); + copyAstLoc (assignTree, tree); + } + + gotoTree = newNode (GOTO, + newAst_VALUE (symbolVal (inlineState.retlab)), + NULL); + copyAstLoc (gotoTree, tree); + + tree->opval.op = NULLOP; + tree->left = assignTree; + tree->right = gotoTree; + } + + /* Update any children */ + if (tree->left) + fixupInline (tree->left, level); + if (tree->right) + fixupInline (tree->right, level); + + if (IS_AST_OP (tree) && (tree->opval.op == LABEL)) + { + symbol * label = tree->left->opval.val->sym; + + label->key = labelKey++; + /* Add this label back into the symbol table */ + addSym (LabelTab, label, label->name, label->level, 0, 0); + } + + + if (IS_AST_OP (tree) && (tree->opval.op == BLOCK)) + { + level--; + } +} + +/*-----------------------------------------------------------------*/ +/* inlineAddDecl - add a variable declaration to an ast block. It */ +/* is also added to the symbol table if addSymTab */ +/* is nonzero. */ +/*-----------------------------------------------------------------*/ +static void +inlineAddDecl (symbol * sym, ast * block, int addSymTab) +{ + if (block != NULL) + { + symbol **decl = &(block->values.sym); + + sym->level = block->level; + sym->block = block->block; + + while (*decl) + { + if (strcmp ((*decl)->name, sym->name) == 0) + return; + decl = &( (*decl)->next ); + } + + *decl = sym; + + if (addSymTab) + addSym (SymbolTab, sym, sym->name, sym->level, sym->block, 0); + + } +} + + +/*-----------------------------------------------------------------*/ +/* inlineTempVar - create a temporary variable for inlining */ +/*-----------------------------------------------------------------*/ +static symbol * +inlineTempVar (sym_link * type, int level) +{ + symbol * sym; + + sym = newSymbol (genSymName(level), level ); + sym->type = copyLinkChain (type); + sym->etype = getSpec(sym->type); + SPEC_SCLS (sym->etype) = S_AUTO; + SPEC_OCLS (sym->etype) = NULL; + SPEC_EXTR (sym->etype) = 0; + SPEC_STAT (sym->etype) = 0; + if IS_SPEC (sym->type) + SPEC_VOLATILE (sym->type) = 0; + else + DCL_PTR_VOLATILE (sym->type) = 0; + SPEC_ABSA (sym->etype) = 0; + + return sym; +} + + +/*-----------------------------------------------------------------*/ +/* inlineFindParmRecurse - recursive function for inlineFindParm */ +/*-----------------------------------------------------------------*/ +static ast * +inlineFindParmRecurse (ast * parms, int *index) +{ + if (!parms) + return NULL; + + if (parms->type == EX_OP && parms->opval.op == PARAM) + { + ast * p; + + p=inlineFindParmRecurse (parms->left, index); + if (p) + return p; + p=inlineFindParmRecurse (parms->right, index); + if (p) + return p; + } + if (!*index) + return parms; + (*index)--; + return NULL; +} + + +/*-----------------------------------------------------------------*/ +/* inlineFindParm - search an ast tree of parameters to find one */ +/* at a particular index (0=first parameter). */ +/* Returns NULL if not found. */ +/*-----------------------------------------------------------------*/ +static ast * +inlineFindParm (ast * parms, int index) +{ + return inlineFindParmRecurse (parms, &index); +} + + +/*-----------------------------------------------------------------*/ +/* expandInlineFuncs - replace calls to inline functions with the */ +/* function itself */ +/*-----------------------------------------------------------------*/ +static void +expandInlineFuncs (ast * tree, ast * block) +{ + if (IS_AST_OP (tree) && (tree->opval.op == CALL) && tree->left + && IS_AST_VALUE (tree->left) && tree->left->opval.val->sym) + { + symbol * func = tree->left->opval.val->sym; + symbol * csym; + + /* The symbol is probably not bound yet, so find the real one */ + csym = findSymWithLevel (SymbolTab, func); + if (csym) + func = csym; + + /* Is this an inline function that we can inline? */ + if (IFFUNC_ISINLINE (func->type) && func->funcTree) + { + symbol * retsym = NULL; + symbol * retlab; + ast * inlinetree; + ast * inlinetree2; + ast * temptree; + value * args; + int argIndex; + + /* Generate a label for the inlined function to branch to */ + /* in case it contains a return statement */ + retlab = newSymbol (genSymName(tree->level+1), tree->level+1 ); + retlab->isitmp = 1; + retlab->islbl = 1; + inlineState.retlab = retlab; + + /* Build the subtree for the inlined function in the form: */ + /* { //inlinetree block */ + /* { //inlinetree2 block */ + /* inline_function_code; */ + /* retlab: */ + /* } */ + /* } */ + temptree = newNode (LABEL, newAst_VALUE (symbolVal (retlab)), NULL); + copyAstLoc (temptree, tree); + temptree = newNode (NULLOP, copyAst (func->funcTree), temptree); + copyAstLoc (temptree, tree); + temptree = newNode (BLOCK, NULL, temptree); + copyAstLoc (temptree, tree); + inlinetree2 = temptree; + inlinetree = newNode (BLOCK, NULL, inlinetree2); + copyAstLoc (inlinetree, tree); + + /* To pass parameters to the inlined function, we need some */ + /* intermediate variables. This avoids scoping problems */ + /* when the parameter declaration names are used differently */ + /* during the function call. For example, a function */ + /* declared as func(int x, int y) but called as func(y,x). */ + /* { //inlinetree block */ + /* type1 temparg1; */ + /* ... */ + /* typen tempargn; */ + /* temparg1 = argument1; */ + /* ... */ + /* tempargn = argumentn; */ + /* { //inlinetree2 block */ + /* type1 param1; */ + /* ... */ + /* typen paramn; */ + /* param1 = temparg1; */ + /* ... */ + /* paramn = tempargn; */ + /* inline_function_code; */ + /* retlab: */ + /* } */ + /* } */ + args = FUNC_ARGS (func->type); + argIndex = 0; + while (args) + { + symbol * temparg; + ast * passedarg; + ast * assigntree; + symbol * parm = copySymbol (args->sym); + + temparg = inlineTempVar (args->sym->type, tree->level+1); + inlineAddDecl (temparg, inlinetree, FALSE); + + passedarg = inlineFindParm (tree->right, argIndex); + assigntree = newNode ('=', + newAst_VALUE (symbolVal (temparg)), + passedarg); + inlinetree->right = newNode (NULLOP, + assigntree, + inlinetree->right); + + inlineAddDecl (parm, inlinetree2, FALSE); + parm->_isparm = 0; + + assigntree = newNode ('=', + newAst_VALUE (symbolVal (parm)), + newAst_VALUE (symbolVal (temparg))); + inlinetree2->right = newNode (NULLOP, + assigntree, + inlinetree2->right); + + + args = args->next; + argIndex++; + } + + /* Handle the return type */ + if (!IS_VOID (func->type->next)) + { + /* Create a temporary symbol to hold the return value and */ + /* join it with the inlined function using the comma */ + /* operator. The fixupInline function will take care of */ + /* changing return statements into assignments to retsym. */ + /* (parameter passing and return label omitted for clarity) */ + /* rettype retsym; */ + /* ... */ + /* {{inline_function_code}}, retsym */ + + retsym = inlineTempVar (func->type->next, tree->level); + inlineAddDecl (retsym, block, TRUE); + + tree->opval.op = ','; + tree->left = inlinetree; + tree->right = newAst_VALUE (symbolVal (retsym)); + } + else + { + tree->opval.op = NULLOP; + tree->left = NULL; + tree->right = inlinetree; + } + inlineState.retsym = retsym; + + /* Renumber the various internal counters on the inlined */ + /* function's tree nodes and symbols. Add the inlined */ + /* function's local variables to the appropriate scope(s). */ + /* Convert inlined return statements to an assignment to */ + /* retsym (if needed) and a goto retlab. */ + fixupInline (inlinetree, inlinetree->level); + inlineState.count++; + } + + } + + /* Recursively continue to search for functions to inline. */ + if (IS_AST_OP (tree)) + { + if (tree->opval.op == BLOCK) + block = tree; + + if (tree->left) + expandInlineFuncs (tree->left, block); + if (tree->right) + expandInlineFuncs (tree->right, block); + } +} + + /*-----------------------------------------------------------------*/ /* createFunction - This is the key node that calls the iCode for */ /* generating the code for a function. Note code */ @@ -5938,6 +6335,12 @@ createFunction (symbol * name, ast * body) if (IFFUNC_ISREENT (name->type)) reentrant++; + inlineState.count = 0; + expandInlineFuncs (body, NULL); + + if (FUNC_ISINLINE (name->type)) + name->funcTree = copyAst (body); + allocParms (FUNC_ARGS(name->type)); /* allocate the parameters */ /* do processing for parameters that are passed in registers */ @@ -5975,10 +6378,15 @@ createFunction (symbol * name, ast * body) goto skipall; } + /* Do not generate code for inline functions unless extern also */ + if (FUNC_ISINLINE (name->type) && !IS_EXTERN (fetype)) + goto skipall; + /* create the node & generate intermediate code */ GcurMemmap = code; codeOutBuf = &code->oBuf; piCode = iCodeFromAst (ex); + name->generated = 1; if (fatalError) { diff --git a/src/SDCCmem.c b/src/SDCCmem.c index 351e59c9..8204490d 100644 --- a/src/SDCCmem.c +++ b/src/SDCCmem.c @@ -698,11 +698,16 @@ deallocParms (value * val) if (lval->sym->rname[0]) { char buffer[SDCC_NAME_MAX]; + symbol * argsym = lval->sym; + strncpyz (buffer, lval->sym->rname, sizeof(buffer)); lval->sym = copySymbol (lval->sym); strncpyz (lval->sym->rname, buffer, sizeof(lval->sym->rname)); + strncpyz (lval->sym->name, buffer, sizeof(lval->sym->name)); - strncpyz (lval->name, buffer, sizeof(lval->name)); + /* need to keep the original name for inlining to work */ + /*strncpyz (lval->name, buffer, sizeof(lval->name)); */ + addSym (SymbolTab, lval->sym, lval->sym->name, lval->sym->level, lval->sym->block, 1); lval->sym->_isparm = 1; @@ -710,6 +715,9 @@ deallocParms (value * val) { addSet(&operKeyReset, lval->sym); } + + /* restore the original symbol */ + lval->sym = argsym; } } return; diff --git a/src/SDCCsymt.c b/src/SDCCsymt.c index aad7ffa3..205ea312 100644 --- a/src/SDCCsymt.c +++ b/src/SDCCsymt.c @@ -655,6 +655,7 @@ mergeSpec (sym_link * dest, sym_link * src, char *name) dest->select.s.b_signed|=src->select.s.b_signed; SPEC_STAT (dest) |= SPEC_STAT (src); SPEC_EXTR (dest) |= SPEC_EXTR (src); + SPEC_INLINE (dest) |= SPEC_INLINE (src); SPEC_CONST(dest) |= SPEC_CONST (src); SPEC_ABSA (dest) |= SPEC_ABSA (src); SPEC_VOLATILE (dest) |= SPEC_VOLATILE (src); @@ -684,6 +685,7 @@ mergeSpec (sym_link * dest, sym_link * src, char *name) FUNC_ISOVERLAY(dest) |= FUNC_ISOVERLAY(src); FUNC_INTNO(dest) |= FUNC_INTNO(src); FUNC_REGBANK(dest) |= FUNC_REGBANK(src); + FUNC_ISINLINE (dest) |= FUNC_ISINLINE (src); return dest; } @@ -2416,7 +2418,14 @@ checkFunction (symbol * sym, symbol *csym) werror(E_SYNTAX_ERROR, sym->name); return 0; } - + + /* move inline specifier from return type to function attributes */ + if (IS_INLINE (sym->etype)) + { + SPEC_INLINE (sym->etype) = 0; + FUNC_ISINLINE (sym->type) = 1; + } + /* make sure the type is complete and sane */ checkTypeSanity(((symbol *)sym)->etype, ((symbol *)sym)->name); @@ -2874,6 +2883,9 @@ dbuf_printTypeChain (sym_link * start, struct dbuf_s *dbuf) if (DCL_PTR_CONST (type)) { dbuf_append_str (dbuf, "const-"); } + if (DCL_PTR_RESTRICT (type)) { + dbuf_append_str (dbuf, "restrict-"); + } } switch (DCL_TYPE (type)) { @@ -3025,10 +3037,16 @@ printTypeChainRaw (sym_link * start, FILE * of) if (DCL_PTR_CONST (type)) { fprintf (of, "const-"); } + if (DCL_PTR_RESTRICT (type)) { + fprintf (of, "restrict-"); + } } switch (DCL_TYPE (type)) { case FUNCTION: + if (IFFUNC_ISINLINE(type)) { + fprintf (of, "inline-"); + } fprintf (of, "function %s %s", (IFFUNC_ISBUILTIN(type) ? "__builtin__" : " "), (IFFUNC_ISJAVANATIVE(type) ? "_JavaNative" : " ")); diff --git a/src/SDCCsymt.h b/src/SDCCsymt.h index 6ad8662b..10778f32 100644 --- a/src/SDCCsymt.h +++ b/src/SDCCsymt.h @@ -156,6 +156,7 @@ typedef struct specifier unsigned b_signed:1; /* just for sanity checks only*/ unsigned b_static:1; /* 1=static keyword found */ unsigned b_extern:1; /* 1=extern found */ + unsigned b_inline:1; /* inline function requested */ unsigned b_absadr:1; /* absolute address specfied */ unsigned b_volatile:1; /* is marked as volatile */ unsigned b_const:1; /* is a constant */ @@ -246,6 +247,7 @@ typedef struct sym_link unsigned critical:1; /* critical function */ unsigned intrtn:1; /* this is an interrupt routine */ unsigned rbank:1; /* seperate register bank */ + unsigned inlinereq:1; /* inlining requested */ unsigned intno; /* 1=Interrupt svc routine */ short regbank; /* register bank 2b used */ unsigned builtin; /* is a builtin function */ @@ -268,7 +270,7 @@ typedef struct symbol int key; unsigned flexArrayLength; /* if the symbol specifies a struct with a "flexible array member", then the additional length in bytes for - the "fam" is stored here. Because the lenght can be different from symbol + the "fam" is stored here. Because the length can be different from symbol to symbol AND v_struct isn't copied in copyLinkChain(), it's located here in the symbol and not in v_struct or the declarator */ unsigned implicit:1; /* implicit flag */ @@ -285,6 +287,7 @@ typedef struct symbol unsigned addrtaken:1; /* address of the symbol was taken */ unsigned isreqv:1; /* is the register equivalent of a symbol */ unsigned udChked:1; /* use def checking has been already done */ + unsigned generated:1; /* code generated (function symbols only) */ /* following flags are used by the backend for code generation and can be changed @@ -353,6 +356,7 @@ typedef struct symbol int used; /* no. of times this was used */ int recvSize; /* size of first argument */ struct bitVect *clashes; /* overlaps with what other symbols */ + struct ast * funcTree; /* function body ast if inlined */ } symbol; @@ -387,6 +391,8 @@ extern sym_link *validateLink(sym_link *l, #define FUNC_INTNO(x) (x->funcAttrs.intno) #define FUNC_REGBANK(x) (x->funcAttrs.regbank) #define FUNC_HASSTACKPARM(x) (x->funcAttrs.hasStackParms) +#define FUNC_ISINLINE(x) (x->funcAttrs.inlinereq) +#define IFFUNC_ISINLINE(x) (IS_FUNC(x) && FUNC_ISINLINE(x)) #define FUNC_ISREENT(x) (x->funcAttrs.reent) #define IFFUNC_ISREENT(x) (IS_FUNC(x) && FUNC_ISREENT(x)) @@ -446,6 +452,7 @@ extern sym_link *validateLink(sym_link *l, #define SPEC_TYPEDEF(x) validateLink(x, "SPEC_NOUN", #x, SPECIFIER, __FILE__, __LINE__)->select.s.b_typedef #define SPEC_REGPARM(x) validateLink(x, "SPEC_NOUN", #x, SPECIFIER, __FILE__, __LINE__)->select.s.b_isregparm #define SPEC_ARGREG(x) validateLink(x, "SPEC_NOUN", #x, SPECIFIER, __FILE__, __LINE__)->select.s.argreg +#define SPEC_INLINE(x) validateLink(x, "SPEC_INLINE", #x, SPECIFIER, __FILE__, __LINE__)->select.s.b_inline /* type check macros */ #define IS_DECL(x) ( x && x->class == DECLARATOR ) @@ -479,6 +486,7 @@ extern sym_link *validateLink(sym_link *l, #define IS_REGISTER(x) (IS_SPEC(x) && SPEC_SCLS(x) == S_REGISTER) #define IS_RENT(x) (IS_SPEC(x) && x->select.s._reent ) #define IS_STATIC(x) (IS_SPEC(x) && SPEC_STAT(x)) +#define IS_INLINE(x) (IS_SPEC(x) && SPEC_INLINE(x)) #define IS_INT(x) (IS_SPEC(x) && x->select.s.noun == V_INT) #define IS_VOID(x) (IS_SPEC(x) && x->select.s.noun == V_VOID) #define IS_CHAR(x) (IS_SPEC(x) && x->select.s.noun == V_CHAR) diff --git a/support/Util/SDCCerr.c b/support/Util/SDCCerr.c index 6bc3f650..e0aaf930 100644 --- a/support/Util/SDCCerr.c +++ b/support/Util/SDCCerr.c @@ -438,6 +438,8 @@ struct "#pragma %s: bad argument(s); pragma ignored" }, { E_BAD_RESTRICT, ERROR_LEVEL_ERROR, "Only pointers may be qualified with 'restrict'" }, +{ E_BAD_INLINE, ERROR_LEVEL_ERROR, + "Only functions may be qualified with 'inline'" }, }; /* diff --git a/support/Util/SDCCerr.h b/support/Util/SDCCerr.h index bde43554..40e71b95 100644 --- a/support/Util/SDCCerr.h +++ b/support/Util/SDCCerr.h @@ -208,6 +208,7 @@ SDCCERR - SDCC Standard error handler #define W_EMPTY_SOURCE_FILE 190 /* ISO C forbids an empty source file */ #define W_BAD_PRAGMA_ARGUMENTS 191 /* #pragma %s: bad argument(s); pragma ignored */ #define E_BAD_RESTRICT 192 /* Only pointers may be qualified with 'restrict' */ +#define E_BAD_INLINE 193 /* Only functions may be qualified with 'inline' */ #define MAX_ERROR_WARNING 256 /* size of disable warnings array */ /** Describes the maximum error level that will be logged. Any level