X-Git-Url: https://git.sur5r.net/?a=blobdiff_plain;f=src%2Fcc65%2Fexpr.c;h=b71d2d6709d06d16b9926210dc42141496ef933e;hb=73dfa23c987d8a7f1154801b85c171f9e01dcd58;hp=71b9788bacd162183374785a2af4bee3ec390864;hpb=d799cc283ffd8a4c3ec90d64d0793b375e18dc87;p=cc65 diff --git a/src/cc65/expr.c b/src/cc65/expr.c index 71b9788ba..b71d2d670 100644 --- a/src/cc65/expr.c +++ b/src/cc65/expr.c @@ -8,17 +8,18 @@ #include #include -#include /* common */ #include "check.h" +#include "debugflag.h" #include "xmalloc.h" /* cc65 */ #include "asmcode.h" #include "asmlabel.h" +#include "asmstmt.h" +#include "assignment.h" #include "codegen.h" -#include "datatype.h" #include "declare.h" #include "error.h" #include "funcdesc.h" @@ -30,6 +31,7 @@ #include "scanner.h" #include "stdfunc.h" #include "symtab.h" +#include "typecast.h" #include "typecmp.h" #include "expr.h" @@ -85,8 +87,11 @@ static GenDesc GenOASGN = { TOK_OR_ASSIGN, GEN_NOPUSH, g_or }; -static int hie10 (ExprDesc* lval); -/* Handle ++, --, !, unary - etc. */ +static int hie0 (ExprDesc *lval); +/* Parse comma operator. */ + +static int expr (int (*func) (ExprDesc*), ExprDesc *lval); +/* Expression parser; func is either hie0 or hie1. */ @@ -219,17 +224,15 @@ unsigned assignadjust (type* lhst, ExprDesc* rhs) if (IsClassPtr (rhst)) { /* Pointer -> int conversion */ Warning ("Converting pointer to integer without a cast"); - } else if (!IsClassInt (rhst)) { - Error ("Incompatible types"); - } else { - /* Adjust the int types. To avoid manipulation of TOS mark lhs - * as const. - */ + } else if (IsClassInt (rhst)) { + /* Convert the rhs to the type of the lhs. */ unsigned flags = TypeOf (rhst); if (rhs->Flags == E_MCONST) { flags |= CF_CONST; } - return g_typeadjust (TypeOf (lhst) | CF_CONST, flags); + return g_typecast (TypeOf (lhst), flags); + } else { + Error ("Incompatible types"); } } else if (IsClassPtr (lhst)) { if (IsClassPtr (rhst)) { @@ -239,21 +242,21 @@ unsigned assignadjust (type* lhst, ExprDesc* rhs) * - the lhs pointer is a void pointer. */ if (!IsTypeVoid (Indirect (lhst)) && !IsTypeVoid (Indirect (rhst))) { - /* Compare the types */ - switch (TypeCmp (lhst, rhst)) { + /* Compare the types */ + switch (TypeCmp (lhst, rhst)) { - case TC_INCOMPATIBLE: - Error ("Incompatible pointer types"); - break; + case TC_INCOMPATIBLE: + Error ("Incompatible pointer types"); + break; - case TC_QUAL_DIFF: - Error ("Pointer types differ in type qualifiers"); - break; + case TC_QUAL_DIFF: + Error ("Pointer types differ in type qualifiers"); + break; - default: - /* Ok */ - break; - } + default: + /* Ok */ + break; + } } } else if (IsClassInt (rhst)) { /* Int to pointer assignment is valid only for constant zero */ @@ -280,16 +283,16 @@ unsigned assignadjust (type* lhst, ExprDesc* rhs) -void DefineData (ExprDesc* lval) +void DefineData (ExprDesc* Expr) /* Output a data definition for the given expression */ { - unsigned flags = lval->Flags; + unsigned Flags = Expr->Flags; - switch (flags & E_MCTYPE) { + switch (Flags & E_MCTYPE) { case E_TCONST: /* Number */ - g_defdata (TypeOf (lval->Type) | CF_CONST, lval->ConstVal, 0); + g_defdata (TypeOf (Expr->Type) | CF_CONST, Expr->ConstVal, 0); break; case E_TREGISTER: @@ -304,33 +307,33 @@ void DefineData (ExprDesc* lval) case E_TGLAB: case E_TLLAB: /* Local or global symbol */ - g_defdata (GlobalModeFlags (flags), lval->Name, lval->ConstVal); + g_defdata (GlobalModeFlags (Flags), Expr->Name, Expr->ConstVal); break; case E_TLIT: /* a literal of some kind */ - g_defdata (CF_STATIC, LiteralPoolLabel, lval->ConstVal); + g_defdata (CF_STATIC, LiteralPoolLabel, Expr->ConstVal); break; default: - Internal ("Unknown constant type: %04X", flags); + Internal ("Unknown constant type: %04X", Flags); } } -static void lconst (unsigned flags, ExprDesc* lval) -/* Load primary reg with some constant value. */ +static void LoadConstant (unsigned Flags, ExprDesc* Expr) +/* Load the primary register with some constant value. */ { - switch (lval->Flags & E_MCTYPE) { + switch (Expr->Flags & E_MCTYPE) { case E_TLOFFS: - g_leasp (lval->ConstVal); + g_leasp (Expr->ConstVal); break; case E_TCONST: /* Number constant */ - g_getimmed (flags | TypeOf (lval->Type) | CF_CONST, lval->ConstVal, 0); + g_getimmed (Flags | TypeOf (Expr->Type) | CF_CONST, Expr->ConstVal, 0); break; case E_TREGISTER: @@ -345,24 +348,24 @@ static void lconst (unsigned flags, ExprDesc* lval) case E_TGLAB: case E_TLLAB: /* Local or global symbol, load address */ - flags |= GlobalModeFlags (lval->Flags); - flags &= ~CF_CONST; - g_getimmed (flags, lval->Name, lval->ConstVal); + Flags |= GlobalModeFlags (Expr->Flags); + Flags &= ~CF_CONST; + g_getimmed (Flags, Expr->Name, Expr->ConstVal); break; case E_TLIT: /* Literal string */ - g_getimmed (CF_STATIC, LiteralPoolLabel, lval->ConstVal); + g_getimmed (CF_STATIC, LiteralPoolLabel, Expr->ConstVal); break; default: - Internal ("Unknown constant type: %04X", lval->Flags); + Internal ("Unknown constant type: %04X", Expr->Flags); } } -static int kcalc (int tok, long val1, long val2) +static int kcalc (token_t tok, long val1, long val2) /* Calculate an operation with left and right operand constant. */ { switch (tok) { @@ -410,9 +413,10 @@ static int kcalc (int tok, long val1, long val2) -static GenDesc* FindGen (int Tok, GenDesc** Table) +static const GenDesc* FindGen (token_t Tok, const GenDesc** Table) +/* Find a token in a generator table */ { - GenDesc* G; + const GenDesc* G; while ((G = *Table) != 0) { if (G->Tok == Tok) { return G; @@ -436,12 +440,12 @@ static int istypeexpr (void) (NextTok.Tok == TOK_CONST) || (NextTok.Tok == TOK_IDENT && (Entry = FindSym (NextTok.Ident)) != 0 && - IsTypeDef (Entry))); + SymIsTypeDef (Entry))); } -static void PushAddr (ExprDesc* lval) +void PushAddr (ExprDesc* lval) /* If the expression contains an address that was somehow evaluated, * push this address on the stack. This is a helper function for all * sorts of implicit or explicit assignment functions where the lvalue @@ -450,35 +454,42 @@ static void PushAddr (ExprDesc* lval) { /* Get the address on stack if needed */ if (lval->Flags != E_MREG && (lval->Flags & E_MEXPR)) { - /* Push the address (always a pointer) */ - g_push (CF_PTR, 0); + /* Push the address (always a pointer) */ + g_push (CF_PTR, 0); } } -static void MakeConstIntExpr (ExprDesc* Expr, long Value) -/* Make Expr a constant integer expression with the given value */ -{ - Expr->Flags = E_MCONST; - Expr->Type = type_int; - Expr->ConstVal = 1; -} - - - -static void ConstSubExpr (int (*F) (ExprDesc*), ExprDesc* Expr) +void ConstSubExpr (int (*F) (ExprDesc*), ExprDesc* Expr) /* Will evaluate an expression via the given function. If the result is not * a constant, a diagnostic will be printed, and the value is replaced by * a constant one to make sure there are no internal errors that result * from this input error. */ { - memset (Expr, 0, sizeof (*Expr)); + InitExprDesc (Expr); if (F (Expr) != 0 || Expr->Flags != E_MCONST) { Error ("Constant expression expected"); /* To avoid any compiler errors, make the expression a valid const */ - MakeConstIntExpr (Expr, 1); + MakeConstIntExpr (Expr, 1); + } +} + + + +void CheckBoolExpr (ExprDesc* lval) +/* Check if the given expression is a boolean expression, output a diagnostic + * if not. + */ +{ + /* If it's an integer, it's ok. If it's not an integer, but a pointer, + * the pointer used in a boolean context is also ok + */ + if (!IsClassInt (lval->Type) && !IsClassPtr (lval->Type)) { + Error ("Boolean expression expected"); + /* To avoid any compiler errors, make the expression a valid int */ + MakeConstIntExpr (lval, 1); } } @@ -490,7 +501,7 @@ static void ConstSubExpr (int (*F) (ExprDesc*), ExprDesc* Expr) -void exprhs (unsigned flags, int k, ExprDesc *lval) +void exprhs (unsigned flags, int k, ExprDesc* lval) /* Put the result of an expression into the primary register */ { int f; @@ -498,7 +509,7 @@ void exprhs (unsigned flags, int k, ExprDesc *lval) f = lval->Flags; if (k) { /* Dereferenced lvalue */ - flags |= TypeOf (lval->Type); + flags |= TypeOf (lval->Type); if (lval->Test & E_FORCETEST) { flags |= CF_TEST; lval->Test &= ~E_FORCETEST; @@ -524,12 +535,13 @@ void exprhs (unsigned flags, int k, ExprDesc *lval) g_inc (flags | CF_CONST, lval->ConstVal); } else if ((f & E_MEXPR) == 0) { /* Constant of some sort, load it into the primary */ - lconst (flags, lval); + LoadConstant (flags, lval); } - if (lval->Test & E_FORCETEST) { /* we testing this value? */ - /* debug... */ + /* Are we testing this value? */ + if (lval->Test & E_FORCETEST) { + /* Yes, force a test */ flags |= TypeOf (lval->Type); - g_test (flags); /* yes, force a test */ + g_test (flags); lval->Test &= ~E_FORCETEST; } } @@ -571,8 +583,7 @@ static unsigned FunctionParamList (FuncDesc* Func) FrameSize = Func->ParamSize; if (FrameParams > 0 && (Func->Flags & FD_FASTCALL) != 0) { /* Last parameter is not pushed */ - const SymEntry* LastParam = Func->SymTab->SymTail; - FrameSize -= SizeOf (LastParam->Type); + FrameSize -= CheckedSizeOf (Func->LastParam->Type); --FrameParams; } @@ -631,7 +642,7 @@ static unsigned FunctionParamList (FuncDesc* Func) * use a special function that may optimize. */ CFlags = CF_NONE; - if (!Ellipsis && SizeOf (Param->Type) == 1) { + if (!Ellipsis && CheckedSizeOf (Param->Type) == 1) { CFlags = CF_FORCECHAR; } Flags = CF_NONE; @@ -706,107 +717,122 @@ static unsigned FunctionParamList (FuncDesc* Func) -static void CallFunction (ExprDesc* lval) -/* Perform a function call. Called from hie11, this routine will - * either call the named function, or the function pointer in a/x. - */ +static void FunctionCall (int k, ExprDesc* lval) +/* Perform a function call. */ { - FuncDesc* Func; /* Function descriptor */ - unsigned ParamSize; /* Number of parameter bytes */ - CodeMark Mark; - + FuncDesc* Func; /* Function descriptor */ + int IsFuncPtr; /* Flag */ + unsigned ParamSize; /* Number of parameter bytes */ + CodeMark Mark = 0; /* Initialize to keep gcc silent */ + int PtrOffs = 0; /* Offset of function pointer on stack */ + int IsFastCall = 0; /* True if it's a fast call function */ + int PtrOnStack = 0; /* True if a pointer copy is on stack */ /* Get a pointer to the function descriptor from the type string */ Func = GetFuncDesc (lval->Type); - /* Initialize vars to keep gcc silent */ - Mark = 0; + /* Handle function pointers transparently */ + IsFuncPtr = IsTypeFuncPtr (lval->Type); + if (IsFuncPtr) { - /* Check if this is a function pointer. If so, save it. If not, check for - * special known library functions that may be inlined. - */ - if (lval->Flags & E_MEXPR) { - /* Function pointer is in primary register, save it */ - Mark = GetCodePos (); - g_save (CF_PTR); + /* Check wether it's a fastcall function that has parameters */ + IsFastCall = IsFastCallFunc (lval->Type + 1) && (Func->ParamCount > 0); + + /* Things may be difficult, depending on where the function pointer + * resides. If the function pointer is an expression of some sort + * (not a local or global variable), we have to evaluate this + * expression now and save the result for later. Since calls to + * function pointers may be nested, we must save it onto the stack. + * For fastcall functions we do also need to place a copy of the + * pointer on stack, since we cannot use a/x. + */ + PtrOnStack = IsFastCall || ((lval->Flags & (E_MGLOBAL | E_MLOCAL)) == 0); + if (PtrOnStack) { + + /* Not a global or local variable, or a fastcall function. Load + * the pointer into the primary and mark it as an expression. + */ + exprhs (CF_NONE, k, lval); + lval->Flags |= E_MEXPR; + + /* Remember the code position */ + Mark = GetCodePos (); + + /* Push the pointer onto the stack and remember the offset */ + g_push (CF_PTR, 0); + PtrOffs = oursp; + } + + /* Check for known standard functions and inline them if requested */ } else if (InlineStdFuncs && IsStdFunc ((const char*) lval->Name)) { - /* Inline this function */ - HandleStdFunc (lval); + + /* Inline this function */ + HandleStdFunc (Func, lval); return; + } /* Parse the parameter list */ ParamSize = FunctionParamList (Func); - /* We need the closing bracket here */ + /* We need the closing paren here */ ConsumeRParen (); - /* */ - if (lval->Flags & E_MEXPR) { - /* Function called via pointer: Restore it and call function */ - if (ParamSize != 0) { - g_restore (CF_PTR); - } else { - /* We had no parameters - remove save code */ - RemoveCode (Mark); - } - g_callind (TypeOf (lval->Type), ParamSize); - } else { - g_call (TypeOf (lval->Type), (const char*) lval->Name, ParamSize); - } -} + /* Special handling for function pointers */ + if (IsFuncPtr) { + /* If the function is not a fastcall function, load the pointer to + * the function into the primary. + */ + if (!IsFastCall) { + /* Not a fastcall function - we may use the primary */ + if (PtrOnStack) { + /* If we have no parameters, the pointer is still in the + * primary. Remove the code to push it and correct the + * stack pointer. + */ + if (ParamSize == 0) { + RemoveCode (Mark); + pop (CF_PTR); + PtrOnStack = 0; + } else { + /* Load from the saved copy */ + g_getlocal (CF_PTR, PtrOffs); + } + } else { + /* Load from original location */ + exprhs (CF_NONE, k, lval); + } -void doasm (void) -/* This function parses ASM statements. The syntax of the ASM directive - * looks like the one defined for C++ (C has no ASM directive), that is, - * a string literal in parenthesis. - */ -{ - /* Skip the ASM */ - NextToken (); + /* Call the function */ + g_callind (TypeOf (lval->Type+1), ParamSize, PtrOffs); - /* Need left parenthesis */ - ConsumeLParen (); + } else { - /* String literal */ - if (CurTok.Tok != TOK_SCONST) { - Error ("String literal expected"); - } else { + /* Fastcall function. We cannot use the primary for the function + * pointer and must therefore use an offset to the stack location. + * Since fastcall functions may never be variadic, we can use the + * index register for this purpose. + */ + g_callind (CF_LOCAL, ParamSize, PtrOffs); + } - /* The string literal may consist of more than one line of assembler - * code. Separate the single lines and output the code. - */ - const char* S = GetLiteral (CurTok.IVal); - while (*S) { - - /* Allow lines up to 256 bytes */ - const char* E = strchr (S, '\n'); - if (E) { - /* Found a newline */ - g_asmcode (S, E-S); - S = E+1; - } else { - int Len = strlen (S); - g_asmcode (S, Len); - S += Len; - } + /* If we have a pointer on stack, remove it */ + if (PtrOnStack) { + g_space (- (int) sizeofarg (CF_PTR)); + pop (CF_PTR); } - /* Reset the string pointer, effectivly clearing the string from the - * string table. Since we're working with one token lookahead, this - * will fail if the next token is also a string token, but that's a - * syntax error anyway, because we expect a right paren. - */ - ResetLiteralPoolOffs (CurTok.IVal); - } + /* Skip T_PTR */ + ++lval->Type; - /* Skip the string token */ - NextToken (); + } else { - /* Closing paren needed */ - ConsumeRParen (); + /* Normal function */ + g_call (TypeOf (lval->Type), (const char*) lval->Name, ParamSize); + + } } @@ -816,8 +842,9 @@ static int primary (ExprDesc* lval) { int k; - /* not a test at all, yet */ - lval->Test = 0; + /* Initialize fields in the expression stucture */ + lval->Test = 0; /* No test */ + lval->Sym = 0; /* Symbol unknown */ /* Character and integer constants. */ if (CurTok.Tok == TOK_ICONST || CurTok.Tok == TOK_CCONST) { @@ -833,12 +860,20 @@ static int primary (ExprDesc* lval) */ if (CurTok.Tok == TOK_LPAREN) { NextToken (); - memset (lval, 0, sizeof (*lval)); /* Remove any attributes */ + InitExprDesc (lval); /* Remove any attributes */ k = hie0 (lval); ConsumeRParen (); return k; } + /* If we run into an identifier in preprocessing mode, we assume that this + * is an undefined macro and replace it by a constant value of zero. + */ + if (Preprocessing && CurTok.Tok == TOK_IDENT) { + MakeConstIntExpr (lval, 0); + return 0; + } + /* All others may only be used if the expression evaluation is not called * recursively by the preprocessor. */ @@ -856,7 +891,7 @@ static int primary (ExprDesc* lval) ident Ident; /* Get a pointer to the symbol table entry */ - Sym = FindSym (CurTok.Ident); + Sym = lval->Sym = FindSym (CurTok.Ident); /* Is the symbol known? */ if (Sym) { @@ -881,8 +916,8 @@ static int primary (ExprDesc* lval) /* Check for legal symbol types */ if ((Sym->Flags & SC_CONST) == SC_CONST) { - /* Enum or some other numeric constant */ - lval->Flags = E_MCONST; + /* Enum or some other numeric constant */ + lval->Flags = E_MCONST | E_TCONST; lval->ConstVal = Sym->V.ConstVal; return 0; } else if ((Sym->Flags & SC_FUNC) == SC_FUNC) { @@ -892,19 +927,24 @@ static int primary (ExprDesc* lval) lval->ConstVal = 0; } else if ((Sym->Flags & SC_AUTO) == SC_AUTO) { /* Local variable. If this is a parameter for a variadic - * function, we have to add some address calculations, and the - * address is not const. - */ - if ((Sym->Flags & SC_PARAM) == SC_PARAM && IsVariadic (CurrentFunc)) { - /* Variadic parameter */ - g_leavariadic (Sym->V.Offs - GetParamSize (CurrentFunc)); - lval->Flags = E_MEXPR; - lval->ConstVal = 0; - } else { - /* Normal parameter */ - lval->Flags = E_MLOCAL | E_TLOFFS; - lval->ConstVal = Sym->V.Offs; - } + * function, we have to add some address calculations, and the + * address is not const. + */ + if ((Sym->Flags & SC_PARAM) == SC_PARAM && F_IsVariadic (CurrentFunc)) { + /* Variadic parameter */ + g_leavariadic (Sym->V.Offs - F_GetParamSize (CurrentFunc)); + lval->Flags = E_MEXPR; + lval->ConstVal = 0; + } else { + /* Normal parameter */ + lval->Flags = E_MLOCAL | E_TLOFFS; + lval->ConstVal = Sym->V.Offs; + } + } else if ((Sym->Flags & SC_REGISTER) == SC_REGISTER) { + /* Register variable, zero page based */ + lval->Flags = E_MGLOBAL | E_MCONST | E_TREGISTER; + lval->Name = Sym->V.R.RegOffs; + lval->ConstVal = 0; } else if ((Sym->Flags & SC_STATIC) == SC_STATIC) { /* Static variable */ if (Sym->Flags & (SC_EXTERN | SC_STORAGE)) { @@ -915,11 +955,6 @@ static int primary (ExprDesc* lval) lval->Name = Sym->V.Label; } lval->ConstVal = 0; - } else if ((Sym->Flags & SC_REGISTER) == SC_REGISTER) { - /* Register variable, zero page based */ - lval->Flags = E_MGLOBAL | E_MCONST | E_TREGISTER; - lval->Name = Sym->V.Offs; - lval->ConstVal = 0; } else { /* Local static variable */ lval->Flags = E_MGLOBAL | E_MCONST | E_TLLAB; @@ -970,14 +1005,14 @@ static int primary (ExprDesc* lval) if (CurTok.Tok == TOK_SCONST) { lval->Flags = E_MCONST | E_TLIT; lval->ConstVal = CurTok.IVal; - lval->Type = GetCharArrayType (strlen (GetLiteral (CurTok.IVal))); + lval->Type = GetCharArrayType (GetLiteralPoolOffs () - CurTok.IVal); NextToken (); return 0; } /* ASM statement? */ if (CurTok.Tok == TOK_ASM) { - doasm (); + AsmStatement (); lval->Type = type_void; lval->Flags = E_MEXPR; lval->ConstVal = 0; @@ -1063,15 +1098,16 @@ static int arrayref (int k, ExprDesc* lval) if (IsClassPtr (tptr1)) { /* Scale the subscript value according to element size */ - lval2.ConstVal *= PSizeOf (tptr1); + lval2.ConstVal *= CheckedPSizeOf (tptr1); /* Remove code for lhs load */ RemoveCode (Mark1); /* Handle constant base array on stack. Be sure NOT to - * handle pointers the same way, this won't work. + * handle pointers the same way, and check for character literals + * (both won't work). */ - if (IsTypeArray (tptr1) && + if (IsTypeArray (tptr1) && lval->Flags != (E_MCONST | E_TLIT) && ((lval->Flags & ~E_MCTYPE) == E_MCONST || (lval->Flags & ~E_MCTYPE) == E_MLOCAL || (lval->Flags & E_MGLOBAL) != 0 || @@ -1098,7 +1134,7 @@ static int arrayref (int k, ExprDesc* lval) lval2.Type = Indirect (tptr2); /* Scale the rhs value in the primary register */ - g_scale (TypeOf (tptr1), SizeOf (lval2.Type)); + g_scale (TypeOf (tptr1), CheckedSizeOf (lval2.Type)); /* */ lval->Type = lval2.Type; } else { @@ -1127,7 +1163,7 @@ static int arrayref (int k, ExprDesc* lval) * portion of the index (which is in (e)ax, so there's no further * action required). */ - g_scale (CF_INT, SizeOf (lval->Type)); + g_scale (CF_INT, CheckedSizeOf (lval->Type)); } else if (IsClassPtr (tptr2)) { @@ -1149,7 +1185,7 @@ static int arrayref (int k, ExprDesc* lval) } /* Scale it */ - g_scale (TypeOf (tptr1), SizeOf (lval2.Type)); + g_scale (TypeOf (tptr1), CheckedSizeOf (lval2.Type)); lval->Type = lval2.Type; } else { Error ("Cannot subscript"); @@ -1178,12 +1214,12 @@ static int arrayref (int k, ExprDesc* lval) (rflags & E_MGLOBAL) != 0 || /* Static array, or ... */ rflags == E_MLOCAL; /* Local array */ - if (ConstSubAddr && SizeOf (lval->Type) == 1) { + if (ConstSubAddr && CheckedSizeOf (lval->Type) == SIZEOF_CHAR) { type* SavedType; /* Reverse the order of evaluation */ - unsigned flags = (SizeOf (lval2.Type) == 1)? CF_CHAR : CF_INT; + unsigned flags = (CheckedSizeOf (lval2.Type) == SIZEOF_CHAR)? CF_CHAR : CF_INT; RemoveCode (Mark2); /* Get a pointer to the array into the primary. We have changed @@ -1199,7 +1235,7 @@ static int arrayref (int k, ExprDesc* lval) if (rflags == E_MLOCAL) { g_addlocal (flags, lval2.ConstVal); } else { - flags |= GlobalModeFlags (lval2.Flags); + flags |= GlobalModeFlags (lval2.Flags); g_addstatic (flags, lval2.Name, lval2.ConstVal); } } else { @@ -1207,21 +1243,21 @@ static int arrayref (int k, ExprDesc* lval) /* Constant numeric address. Just add it */ g_inc (CF_INT | CF_UNSIGNED, lval->ConstVal); } else if (lflags == E_MLOCAL) { - /* Base address is a local variable address */ - if (IsTypeArray (tptr1)) { + /* Base address is a local variable address */ + if (IsTypeArray (tptr1)) { g_addaddr_local (CF_INT, lval->ConstVal); - } else { + } else { g_addlocal (CF_PTR, lval->ConstVal); - } + } } else { /* Base address is a static variable address */ unsigned flags = CF_INT; - flags |= GlobalModeFlags (lval->Flags); - if (IsTypeArray (tptr1)) { + flags |= GlobalModeFlags (lval->Flags); + if (IsTypeArray (tptr1)) { g_addaddr_static (flags, lval->Name, lval->ConstVal); - } else { - g_addstatic (flags, lval->Name, lval->ConstVal); - } + } else { + g_addstatic (flags, lval->Name, lval->ConstVal); + } } } } @@ -1264,8 +1300,8 @@ static int structref (int k, ExprDesc* lval) flags = lval->Flags & ~E_MCTYPE; if (flags == E_MCONST || (k == 0 && (flags == E_MLOCAL || - (flags & E_MGLOBAL) != 0 || - lval->Flags == E_MEOFFS))) { + (flags & E_MGLOBAL) != 0 || + lval->Flags == E_MEOFFS))) { lval->ConstVal += Field->V.Offs; } else { if ((flags & E_MEXPR) == 0 || k != 0) { @@ -1305,16 +1341,17 @@ static int hie11 (ExprDesc *lval) /* Function call. Skip the opening parenthesis */ NextToken (); tptr = lval->Type; - if (IsTypeFunc (tptr) || IsTypeFuncPtr (tptr)) { - if (IsTypeFuncPtr (tptr)) { - /* Pointer to function. Handle transparently */ - exprhs (CF_NONE, k, lval); /* Function pointer to A/X */ - ++lval->Type; /* Skip T_PTR */ - lval->Flags |= E_MEXPR; - } - CallFunction (lval); + if (IsTypeFunc (lval->Type) || IsTypeFuncPtr (lval->Type)) { + + /* Call the function */ + FunctionCall (k, lval); + + /* Result is in the primary register */ lval->Flags = E_MEXPR; - lval->Type += DECODE_SIZE + 1; /* Set to result */ + + /* Set to result */ + lval->Type = GetFuncReturn (lval->Type); + } else { Error ("Illegal function call"); } @@ -1343,34 +1380,46 @@ static int hie11 (ExprDesc *lval) -static void store (ExprDesc* lval) -/* Store primary reg into this reference */ +void Store (ExprDesc* lval, const type* StoreType) +/* Store the primary register into the location denoted by lval. If StoreType + * is given, use this type when storing instead of lval->Type. If StoreType + * is NULL, use lval->Type instead. + */ { - int f; - unsigned flags; + unsigned Flags; - f = lval->Flags; - flags = TypeOf (lval->Type); + unsigned f = lval->Flags; + + /* If StoreType was not given, use lval->Type instead */ + if (StoreType == 0) { + StoreType = lval->Type; + } + + /* Get the code generator flags */ + Flags = TypeOf (StoreType); if (f & E_MGLOBAL) { - flags |= GlobalModeFlags (f); + Flags |= GlobalModeFlags (f); if (lval->Test) { - /* Just testing */ - flags |= CF_TEST; - } + /* Just testing */ + Flags |= CF_TEST; + } /* Generate code */ - g_putstatic (flags, lval->Name, lval->ConstVal); + g_putstatic (Flags, lval->Name, lval->ConstVal); } else if (f & E_MLOCAL) { - g_putlocal (flags, lval->ConstVal, 0); + /* Store an auto variable */ + g_putlocal (Flags, lval->ConstVal, 0); } else if (f == E_MEOFFS) { - g_putind (flags, lval->ConstVal); + /* Store indirect with offset */ + g_putind (Flags, lval->ConstVal); } else if (f != E_MREG) { if (f & E_MEXPR) { - g_putind (flags, 0); + /* Indirect without offset */ + g_putind (Flags, 0); } else { /* Store into absolute address */ - g_putstatic (flags | CF_ABSOLUTE, lval->ConstVal, 0); + g_putstatic (Flags | CF_ABSOLUTE, lval->ConstVal, 0); } } @@ -1397,7 +1446,7 @@ static void pre_incdec (ExprDesc* lval, void (*inc) (unsigned, unsigned long)) flags = TypeOf (lval->Type) | CF_FORCECHAR | CF_CONST; /* Get the increment value in bytes */ - val = (lval->Type [0] == T_PTR)? PSizeOf (lval->Type) : 1; + val = (lval->Type [0] == T_PTR)? CheckedPSizeOf (lval->Type) : 1; /* We're currently only able to handle some adressing modes */ if ((lval->Flags & E_MGLOBAL) == 0 && /* Global address? */ @@ -1415,7 +1464,7 @@ static void pre_incdec (ExprDesc* lval, void (*inc) (unsigned, unsigned long)) inc (flags, val); /* Store the result back */ - store (lval); + Store (lval, 0); } else { @@ -1462,7 +1511,7 @@ static void pre_incdec (ExprDesc* lval, void (*inc) (unsigned, unsigned long)) -static void post_incdec (ExprDesc *lval, int k, void (*inc) (unsigned, unsigned long)) +static void post_incdec (ExprDesc* lval, int k, void (*inc) (unsigned, unsigned long)) /* Handle i-- and i++ */ { unsigned flags; @@ -1485,13 +1534,13 @@ static void post_incdec (ExprDesc *lval, int k, void (*inc) (unsigned, unsigned /* If we have a pointer expression, increment by the size of the type */ if (lval->Type[0] == T_PTR) { - inc (flags | CF_CONST | CF_FORCECHAR, SizeOf (lval->Type + 1)); + inc (flags | CF_CONST | CF_FORCECHAR, CheckedSizeOf (lval->Type + 1)); } else { inc (flags | CF_CONST | CF_FORCECHAR, 1); } /* Store the result back */ - store (lval); + Store (lval, 0); /* Restore the original value */ g_restore (flags | CF_FORCECHAR); @@ -1536,101 +1585,7 @@ static void unaryop (int tok, ExprDesc* lval) -static int typecast (ExprDesc* lval) -/* Handle an explicit cast */ -{ - int k; - type Type[MAXTYPELEN]; - - /* Skip the left paren */ - NextToken (); - - /* Read the type */ - ParseType (Type); - - /* Closing paren */ - ConsumeRParen (); - - /* Read the expression we have to cast */ - k = hie10 (lval); - - /* If the expression is a function, treat it as pointer-to-function */ - if (IsTypeFunc (lval->Type)) { - lval->Type = PointerTo (lval->Type); - } - - /* Check for a constant on the right side */ - if (k == 0 && lval->Flags == E_MCONST) { - - /* A cast of a constant to something else. If the new type is an int, - * be sure to handle the size extension correctly. If the new type is - * not an int, the cast is implementation specific anyway, so leave - * the value alone. - */ - if (IsClassInt (Type)) { - - /* Get the current and new size of the value */ - unsigned OldSize = SizeOf (lval->Type); - unsigned NewSize = SizeOf (Type); - unsigned OldBits = OldSize * 8; - unsigned NewBits = NewSize * 8; - - /* Check if the new datatype will have a smaller range */ - if (NewSize < OldSize) { - - /* Cut the value to the new size */ - lval->ConstVal &= (0xFFFFFFFFUL >> (32 - NewBits)); - - /* If the new value is signed, sign extend the value */ - if (!IsSignUnsigned (Type)) { - lval->ConstVal |= ((~0L) << NewBits); - } - - } else if (NewSize > OldSize) { - - /* Sign extend the value if needed */ - if (!IsSignUnsigned (Type) && !IsSignUnsigned (lval->Type)) { - if (lval->ConstVal & (0x01UL << (OldBits-1))) { - lval->ConstVal |= ((~0L) << OldBits); - } - } - } - } - - } else { - - /* Not a constant. Be sure to ignore casts to void */ - if (!IsTypeVoid (Type)) { - - /* If the size does not change, leave the value alone. Otherwise, - * we have to load the value into the primary and generate code to - * cast the value in the primary register. - */ - if (SizeOf (Type) != SizeOf (lval->Type)) { - - /* Load the value into the primary */ - exprhs (CF_NONE, k, lval); - - /* Mark the lhs as const to avoid a manipulation of TOS */ - g_typecast (TypeOf (Type) | CF_CONST, TypeOf (lval->Type)); - - /* Value is now in primary */ - lval->Flags = E_MEXPR; - k = 0; - } - } - } - - /* In any case, use the new type */ - lval->Type = TypeDup (Type); - - /* Done */ - return k; -} - - - -static int hie10 (ExprDesc* lval) +int hie10 (ExprDesc* lval) /* Handle ++, --, !, unary - etc. */ { int k; @@ -1655,29 +1610,37 @@ static int hie10 (ExprDesc* lval) case TOK_BOOL_NOT: NextToken (); if (evalexpr (CF_NONE, hie10, lval) == 0) { - /* Constant expression */ - lval->ConstVal = !lval->ConstVal; + /* Constant expression */ + lval->ConstVal = !lval->ConstVal; } else { - g_bneg (TypeOf (lval->Type)); - lval->Test |= E_CC; /* bneg will set cc */ - lval->Flags = E_MEXPR; /* say it's an expr */ + g_bneg (TypeOf (lval->Type)); + lval->Test |= E_CC; /* bneg will set cc */ + lval->Flags = E_MEXPR; /* say it's an expr */ } return 0; /* expr not storable */ case TOK_STAR: NextToken (); if (evalexpr (CF_NONE, hie10, lval) != 0) { - /* Expression is not const, indirect value loaded into primary */ - lval->Flags = E_MEXPR; - lval->ConstVal = 0; /* Offset is zero now */ + /* Expression is not const, indirect value loaded into primary */ + lval->Flags = E_MEXPR; + lval->ConstVal = 0; /* Offset is zero now */ } - t = lval->Type; - if (IsClassPtr (t)) { - lval->Type = Indirect (t); - } else { - Error ("Illegal indirection"); - } - return 1; + /* If the expression is already a pointer to function, the + * additional dereferencing operator must be ignored. + */ + if (IsTypeFuncPtr (lval->Type)) { + /* Expression not storable */ + return 0; + } else { + if (IsClassPtr (lval->Type)) { + lval->Type = Indirect (lval->Type); + } else { + Error ("Illegal indirection"); + } + return 1; + } + break; case TOK_AND: NextToken (); @@ -1686,32 +1649,32 @@ static int hie10 (ExprDesc* lval) * applied to functions, even if they're no lvalues. */ if (k == 0 && !IsTypeFunc (lval->Type)) { - /* Allow the & operator with an array */ - if (!IsTypeArray (lval->Type)) { - Error ("Illegal address"); - } + /* Allow the & operator with an array */ + if (!IsTypeArray (lval->Type)) { + Error ("Illegal address"); + } } else { - t = TypeAlloc (TypeLen (lval->Type) + 2); - t [0] = T_PTR; - TypeCpy (t + 1, lval->Type); - lval->Type = t; + t = TypeAlloc (TypeLen (lval->Type) + 2); + t [0] = T_PTR; + TypeCpy (t + 1, lval->Type); + lval->Type = t; } return 0; case TOK_SIZEOF: NextToken (); if (istypeexpr ()) { - type Type[MAXTYPELEN]; - NextToken (); - lval->ConstVal = SizeOf (ParseType (Type)); - ConsumeRParen (); + type Type[MAXTYPELEN]; + NextToken (); + lval->ConstVal = CheckedSizeOf (ParseType (Type)); + ConsumeRParen (); } else { - /* Remember the output queue pointer */ - CodeMark Mark = GetCodePos (); - hie10 (lval); - lval->ConstVal = SizeOf (lval->Type); - /* Remove any generated code */ - RemoveCode (Mark); + /* Remember the output queue pointer */ + CodeMark Mark = GetCodePos (); + hie10 (lval); + lval->ConstVal = CheckedSizeOf (lval->Type); + /* Remove any generated code */ + RemoveCode (Mark); } lval->Flags = E_MCONST | E_TCONST; lval->Type = type_uint; @@ -1720,8 +1683,8 @@ static int hie10 (ExprDesc* lval) default: if (istypeexpr ()) { - /* A cast */ - return typecast (lval); + /* A cast */ + return TypeCast (lval); } } @@ -1742,17 +1705,17 @@ static int hie10 (ExprDesc* lval) -static int hie_internal (GenDesc** ops, /* List of generators */ +static int hie_internal (const GenDesc** ops, /* List of generators */ ExprDesc* lval, /* parent expr's lval */ int (*hienext) (ExprDesc*), - int* UsedGen) /* next higher level */ + int* UsedGen) /* next higher level */ /* Helper function */ { int k; ExprDesc lval2; CodeMark Mark1; CodeMark Mark2; - GenDesc* Gen; + const GenDesc* Gen; token_t tok; /* The operator token */ unsigned ltype, type; int rconst; /* Operand is a constant */ @@ -1852,8 +1815,8 @@ static int hie_internal (GenDesc** ops, /* List of generators */ -static int hie_compare (GenDesc** ops, /* List of generators */ - ExprDesc* lval, /* parent expr's lval */ +static int hie_compare (const GenDesc** ops, /* List of generators */ + ExprDesc* lval, /* parent expr's lval */ int (*hienext) (ExprDesc*)) /* Helper function for the compare operators */ { @@ -1861,7 +1824,7 @@ static int hie_compare (GenDesc** ops, /* List of generators */ ExprDesc lval2; CodeMark Mark1; CodeMark Mark2; - GenDesc* Gen; + const GenDesc* Gen; token_t tok; /* The operator token */ unsigned ltype; int rconst; /* Operand is a constant */ @@ -1979,7 +1942,7 @@ static int hie_compare (GenDesc** ops, /* List of generators */ static int hie9 (ExprDesc *lval) /* Process * and / operators. */ { - static GenDesc* hie9_ops [] = { + static const GenDesc* hie9_ops [] = { &GenMUL, &GenDIV, &GenMOD, 0 }; int UsedGen; @@ -2013,7 +1976,8 @@ static void parseadd (int k, ExprDesc* lval) if (k == 0 && (lval->Flags & E_MCONST) != 0) { /* The left hand side is a constant. Good. Get rhs */ - if (evalexpr (CF_NONE, hie9, &lval2) == 0) { + k = hie9 (&lval2); + if (k == 0 && lval2.Flags == E_MCONST) { /* Right hand side is also constant. Get the rhs type */ rhst = lval2.Type; @@ -2021,11 +1985,11 @@ static void parseadd (int k, ExprDesc* lval) /* Both expressions are constants. Check for pointer arithmetic */ if (IsClassPtr (lhst) && IsClassInt (rhst)) { /* Left is pointer, right is int, must scale rhs */ - lval->ConstVal = lval->ConstVal + lval2.ConstVal * PSizeOf (lhst); + lval->ConstVal += lval2.ConstVal * CheckedPSizeOf (lhst); /* Result type is a pointer */ } else if (IsClassInt (lhst) && IsClassPtr (rhst)) { /* Left is int, right is pointer, must scale lhs */ - lval->ConstVal = lval->ConstVal * PSizeOf (rhst) + lval2.ConstVal; + lval->ConstVal = lval->ConstVal * CheckedPSizeOf (rhst) + lval2.ConstVal; /* Result type is a pointer */ lval->Type = lval2.Type; } else if (IsClassInt (lhst) && IsClassInt (rhst)) { @@ -2042,32 +2006,86 @@ static void parseadd (int k, ExprDesc* lval) } else { - /* lhs is constant, rhs is not. Get the rhs type. */ + /* lhs is a constant and rhs is not constant. Load rhs into + * the primary. + */ + exprhs (CF_NONE, k, &lval2); + + /* Beware: The check above (for lhs) lets not only pass numeric + * constants, but also constant addresses (labels), maybe even + * with an offset. We have to check for that here. + */ + + /* First, get the rhs type. */ rhst = lval2.Type; + /* Setup flags */ + if (lval->Flags == E_MCONST) { + /* A numerical constant */ + flags |= CF_CONST; + } else { + /* Constant address label */ + flags |= GlobalModeFlags (lval->Flags) | CF_CONSTADDR; + } + /* Check for pointer arithmetic */ if (IsClassPtr (lhst) && IsClassInt (rhst)) { /* Left is pointer, right is int, must scale rhs */ - g_scale (CF_INT, PSizeOf (lhst)); + g_scale (CF_INT, CheckedPSizeOf (lhst)); /* Operate on pointers, result type is a pointer */ - flags = CF_PTR; + flags |= CF_PTR; + /* Generate the code for the add */ + if (lval->Flags == E_MCONST) { + /* Numeric constant */ + g_inc (flags, lval->ConstVal); + } else { + /* Constant address */ + g_addaddr_static (flags, lval->Name, lval->ConstVal); + } } else if (IsClassInt (lhst) && IsClassPtr (rhst)) { - /* Left is int, right is pointer, must scale lhs */ - lval->ConstVal *= PSizeOf (rhst); - /* Operate on pointers, result type is a pointer */ - flags = CF_PTR; - lval->Type = lval2.Type; + + /* Left is int, right is pointer, must scale lhs. */ + unsigned ScaleFactor = CheckedPSizeOf (rhst); + + /* Operate on pointers, result type is a pointer */ + flags |= CF_PTR; + lval->Type = lval2.Type; + + /* Since we do already have rhs in the primary, if lhs is + * not a numeric constant, and the scale factor is not one + * (no scaling), we must take the long way over the stack. + */ + if (lval->Flags == E_MCONST) { + /* Numeric constant, scale lhs */ + lval->ConstVal *= ScaleFactor; + /* Generate the code for the add */ + g_inc (flags, lval->ConstVal); + } else if (ScaleFactor == 1) { + /* Constant address but no need to scale */ + g_addaddr_static (flags, lval->Name, lval->ConstVal); + } else { + /* Constant address that must be scaled */ + g_push (TypeOf (lval2.Type), 0); /* rhs --> stack */ + g_getimmed (flags, lval->Name, lval->ConstVal); + g_scale (CF_PTR, ScaleFactor); + g_add (CF_PTR, 0); + } } else if (IsClassInt (lhst) && IsClassInt (rhst)) { /* Integer addition */ - flags = typeadjust (lval, &lval2, 1); + flags |= typeadjust (lval, &lval2, 1); + /* Generate the code for the add */ + if (lval->Flags == E_MCONST) { + /* Numeric constant */ + g_inc (flags, lval->ConstVal); + } else { + /* Constant address */ + g_addaddr_static (flags, lval->Name, lval->ConstVal); + } } else { /* OOPS */ Error ("Invalid operands for binary operator `+'"); } - /* Generate code for the add */ - g_inc (flags | CF_CONST, lval->ConstVal); - /* Result is in primary register */ lval->Flags = E_MEXPR; lval->Test &= ~E_CC; @@ -2094,12 +2112,12 @@ static void parseadd (int k, ExprDesc* lval) /* Check for pointer arithmetic */ if (IsClassPtr (lhst) && IsClassInt (rhst)) { /* Left is pointer, right is int, must scale rhs */ - lval2.ConstVal *= PSizeOf (lhst); + lval2.ConstVal *= CheckedPSizeOf (lhst); /* Operate on pointers, result type is a pointer */ flags = CF_PTR; } else if (IsClassInt (lhst) && IsClassPtr (rhst)) { /* Left is int, right is pointer, must scale lhs (ptr only) */ - g_scale (CF_INT | CF_CONST, PSizeOf (rhst)); + g_scale (CF_INT | CF_CONST, CheckedPSizeOf (rhst)); /* Operate on pointers, result type is a pointer */ flags = CF_PTR; lval->Type = lval2.Type; @@ -2126,20 +2144,28 @@ static void parseadd (int k, ExprDesc* lval) /* Check for pointer arithmetic */ if (IsClassPtr (lhst) && IsClassInt (rhst)) { /* Left is pointer, right is int, must scale rhs */ - g_scale (CF_INT, PSizeOf (lhst)); + g_scale (CF_INT, CheckedPSizeOf (lhst)); /* Operate on pointers, result type is a pointer */ flags = CF_PTR; } else if (IsClassInt (lhst) && IsClassPtr (rhst)) { /* Left is int, right is pointer, must scale lhs */ g_tosint (TypeOf (rhst)); /* Make sure, TOS is int */ g_swap (CF_INT); /* Swap TOS and primary */ - g_scale (CF_INT, PSizeOf (rhst)); + g_scale (CF_INT, CheckedPSizeOf (rhst)); /* Operate on pointers, result type is a pointer */ flags = CF_PTR; lval->Type = lval2.Type; } else if (IsClassInt (lhst) && IsClassInt (rhst)) { - /* Integer addition */ - flags = typeadjust (lval, &lval2, 0); + /* Integer addition. Note: Result is never constant. + * Problem here is that typeadjust does not know if the + * variable is an rvalue or lvalue, so if both operands + * are dereferenced constant numeric addresses, typeadjust + * thinks the operation works on constants. Removing + * CF_CONST here means handling the symptoms, however, the + * whole parser is such a mess that I fear to break anything + * when trying to apply another solution. + */ + flags = typeadjust (lval, &lval2, 0) & ~CF_CONST; } else { /* OOPS */ Error ("Invalid operands for binary operator `+'"); @@ -2204,14 +2230,15 @@ static void parsesub (int k, ExprDesc* lval) /* Check for pointer arithmetic */ if (IsClassPtr (lhst) && IsClassInt (rhst)) { /* Left is pointer, right is int, must scale rhs */ - lval->ConstVal -= lval2.ConstVal * PSizeOf (lhst); + lval->ConstVal -= lval2.ConstVal * CheckedPSizeOf (lhst); /* Operate on pointers, result type is a pointer */ } else if (IsClassPtr (lhst) && IsClassPtr (rhst)) { /* Left is pointer, right is pointer, must scale result */ - if (TypeCmp (Indirect (lhst), Indirect (rhst)) < TC_EQUAL) { + if (TypeCmp (Indirect (lhst), Indirect (rhst)) < TC_QUAL_DIFF) { Error ("Incompatible pointer types"); } else { - lval->ConstVal = (lval->ConstVal - lval2.ConstVal) / PSizeOf (lhst); + lval->ConstVal = (lval->ConstVal - lval2.ConstVal) / + CheckedPSizeOf (lhst); } /* Operate on pointers, result type is an integer */ lval->Type = type_int; @@ -2238,15 +2265,15 @@ static void parsesub (int k, ExprDesc* lval) if (IsClassPtr (lhst) && IsClassInt (rhst)) { /* Left is pointer, right is int, must scale rhs */ - lval2.ConstVal *= PSizeOf (lhst); + lval2.ConstVal *= CheckedPSizeOf (lhst); /* Operate on pointers, result type is a pointer */ flags = CF_PTR; } else if (IsClassPtr (lhst) && IsClassPtr (rhst)) { /* Left is pointer, right is pointer, must scale result */ - if (TypeCmp (Indirect (lhst), Indirect (rhst)) < TC_EQUAL) { + if (TypeCmp (Indirect (lhst), Indirect (rhst)) < TC_QUAL_DIFF) { Error ("Incompatible pointer types"); } else { - rscale = PSizeOf (lhst); + rscale = CheckedPSizeOf (lhst); } /* Operate on pointers, result type is an integer */ flags = CF_PTR; @@ -2281,15 +2308,15 @@ static void parsesub (int k, ExprDesc* lval) /* Check for pointer arithmetic */ if (IsClassPtr (lhst) && IsClassInt (rhst)) { /* Left is pointer, right is int, must scale rhs */ - g_scale (CF_INT, PSizeOf (lhst)); + g_scale (CF_INT, CheckedPSizeOf (lhst)); /* Operate on pointers, result type is a pointer */ flags = CF_PTR; } else if (IsClassPtr (lhst) && IsClassPtr (rhst)) { /* Left is pointer, right is pointer, must scale result */ - if (TypeCmp (Indirect (lhst), Indirect (rhst)) < TC_EQUAL) { + if (TypeCmp (Indirect (lhst), Indirect (rhst)) < TC_QUAL_DIFF) { Error ("Incompatible pointer types"); } else { - rscale = PSizeOf (lhst); + rscale = CheckedPSizeOf (lhst); } /* Operate on pointers, result type is an integer */ flags = CF_PTR; @@ -2347,7 +2374,7 @@ static int hie8 (ExprDesc* lval) static int hie7 (ExprDesc *lval) /* Parse << and >>. */ { - static GenDesc* hie7_ops [] = { + static const GenDesc* hie7_ops [] = { &GenASL, &GenASR, 0 }; int UsedGen; @@ -2360,7 +2387,7 @@ static int hie7 (ExprDesc *lval) static int hie6 (ExprDesc *lval) /* process greater-than type comparators */ { - static GenDesc* hie6_ops [] = { + static const GenDesc* hie6_ops [] = { &GenLT, &GenLE, &GenGE, &GenGT, 0 }; return hie_compare (hie6_ops, lval, hie7); @@ -2370,7 +2397,7 @@ static int hie6 (ExprDesc *lval) static int hie5 (ExprDesc *lval) { - static GenDesc* hie5_ops[] = { + static const GenDesc* hie5_ops[] = { &GenEQ, &GenNE, 0 }; return hie_compare (hie5_ops, lval, hie6); @@ -2381,7 +2408,7 @@ static int hie5 (ExprDesc *lval) static int hie4 (ExprDesc* lval) /* Handle & (bitwise and) */ { - static GenDesc* hie4_ops [] = { + static const GenDesc* hie4_ops [] = { &GenAND, 0 }; int UsedGen; @@ -2394,7 +2421,7 @@ static int hie4 (ExprDesc* lval) static int hie3 (ExprDesc *lval) /* Handle ^ (bitwise exclusive or) */ { - static GenDesc* hie3_ops [] = { + static const GenDesc* hie3_ops [] = { &GenXOR, 0 }; int UsedGen; @@ -2407,7 +2434,7 @@ static int hie3 (ExprDesc *lval) static int hie2 (ExprDesc *lval) /* Handle | (bitwise or) */ { - static GenDesc* hie2_ops [] = { + static const GenDesc* hie2_ops [] = { &GenOR, 0 }; int UsedGen; @@ -2640,9 +2667,6 @@ static int hieQuest (ExprDesc *lval) type* type2; /* Type of expression 2 */ type* type3; /* Type of expression 3 */ type* rtype; /* Type of result */ - CodeMark Mark1; /* Save position in output code */ - CodeMark Mark2; /* Save position in output code */ - k = Preprocessing? hieOrPP (lval) : hieOr (lval); @@ -2656,13 +2680,25 @@ static int hieQuest (ExprDesc *lval) labf = GetLocalLabel (); g_falsejump (CF_NONE, labf); - /* Parse second and third expression */ - expression1 (&lval2); + /* Parse second expression */ + k = expr (hie1, &lval2); + type2 = lval2.Type; + if (!IsTypeVoid (lval2.Type)) { + /* Load it into the primary */ + exprhs (CF_NONE, k, &lval2); + } labt = GetLocalLabel (); ConsumeColon (); g_jump (labt); + + /* Parse the third expression */ g_defcodelabel (labf); - expression1 (&lval3); + k = expr (hie1, &lval3); + type3 = lval3.Type; + if (!IsTypeVoid (lval3.Type)) { + /* Load it into the primary */ + exprhs (CF_NONE, k, &lval3); + } /* Check if any conversions are needed, if so, do them. * Conversion rules for ?: expression are: @@ -2673,10 +2709,10 @@ static int hieQuest (ExprDesc *lval) * - if one of the expressions is a pointer and the other is * a zero constant, the resulting type is that of the pointer * type. + * - if both expressions are void expressions, the result is of + * type void. * - all other cases are flagged by an error. */ - type2 = lval2.Type; - type3 = lval3.Type; if (IsClassInt (type2) && IsClassInt (type3)) { /* Get common type */ @@ -2689,14 +2725,12 @@ static int hieQuest (ExprDesc *lval) * the type cast code for expr2. */ labf = GetLocalLabel (); /* Get new label */ - Mark1 = GetCodePos (); /* Remember current position */ g_jump (labf); /* Jump around code */ /* The jump for expr2 goes here */ g_defcodelabel (labt); /* Create the typecast code for expr2 */ - Mark2 = GetCodePos (); /* Remember position */ g_typecast (TypeOf (rtype), TypeOf (type2)); /* Jump here around the typecase code. */ @@ -2706,7 +2740,7 @@ static int hieQuest (ExprDesc *lval) } else if (IsClassPtr (type2) && IsClassPtr (type3)) { /* Must point to same type */ if (TypeCmp (Indirect (type2), Indirect (type3)) < TC_EQUAL) { - Error ("Incompatible pointer types"); + Error ("Incompatible pointer types"); } /* Result has the common type */ rtype = lval2.Type; @@ -2716,6 +2750,9 @@ static int hieQuest (ExprDesc *lval) } else if (IsNullPtr (&lval2) && IsClassPtr (type3)) { /* Result type is pointer, no cast needed */ rtype = lval3.Type; + } else if (IsTypeVoid (type2) && IsTypeVoid (type3)) { + /* Result type is void */ + rtype = lval3.Type; } else { Error ("Incompatible types"); rtype = lval2.Type; /* Doesn't matter here */ @@ -2736,7 +2773,7 @@ static int hieQuest (ExprDesc *lval) -static void opeq (GenDesc* Gen, ExprDesc *lval, int k) +static void opeq (const GenDesc* Gen, ExprDesc *lval, int k) /* Process "op=" operators. */ { ExprDesc lval2; @@ -2776,13 +2813,13 @@ static void opeq (GenDesc* Gen, ExprDesc *lval, int k) } if (MustScale) { /* lhs is a pointer, scale rhs */ - lval2.ConstVal *= SizeOf (lval->Type+1); + lval2.ConstVal *= CheckedSizeOf (lval->Type+1); } /* If the lhs is character sized, the operation may be later done * with characters. */ - if (SizeOf (lval->Type) == 1) { + if (CheckedSizeOf (lval->Type) == SIZEOF_CHAR) { flags |= CF_FORCECHAR; } @@ -2798,39 +2835,40 @@ static void opeq (GenDesc* Gen, ExprDesc *lval, int k) /* rhs is not constant and already in the primary register */ if (MustScale) { /* lhs is a pointer, scale rhs */ - g_scale (TypeOf (lval2.Type), SizeOf (lval->Type+1)); + g_scale (TypeOf (lval2.Type), CheckedSizeOf (lval->Type+1)); } /* If the lhs is character sized, the operation may be later done * with characters. */ - if (SizeOf (lval->Type) == 1) { + if (CheckedSizeOf (lval->Type) == SIZEOF_CHAR) { flags |= CF_FORCECHAR; } /* Adjust the types of the operands if needed */ Gen->Func (g_typeadjust (flags, TypeOf (lval2.Type)), 0); } - store (lval); + Store (lval, 0); lval->Flags = E_MEXPR; } -static void addsubeq (GenDesc* Gen, ExprDesc *lval, int k) +static void addsubeq (const GenDesc* Gen, ExprDesc *lval, int k) /* Process the += and -= operators */ { ExprDesc lval2; - unsigned flags; + unsigned lflags; + unsigned rflags; int MustScale; + /* We must have an lvalue */ if (k == 0) { Error ("Invalid lvalue in assignment"); return; } - /* We're currently only able to handle some adressing modes */ if ((lval->Flags & E_MGLOBAL) == 0 && /* Global address? */ (lval->Flags & E_MLOCAL) == 0 && /* Local address? */ @@ -2846,58 +2884,64 @@ static void addsubeq (GenDesc* Gen, ExprDesc *lval, int k) /* Check if we have a pointer expression and must scale rhs */ MustScale = (lval->Type [0] == T_PTR); - /* Determine the code generator flags */ - flags = TypeOf (lval->Type) | CF_FORCECHAR; + /* Initialize the code generator flags */ + lflags = 0; + rflags = 0; /* Evaluate the rhs */ if (evalexpr (CF_NONE, hie1, &lval2) == 0) { - /* The resulting value is a constant. */ + /* The resulting value is a constant. */ if (MustScale) { - /* lhs is a pointer, scale rhs */ - lval2.ConstVal *= SizeOf (lval->Type+1); - } - flags |= CF_CONST; + /* lhs is a pointer, scale rhs */ + lval2.ConstVal *= CheckedSizeOf (lval->Type+1); + } + rflags |= CF_CONST; + lflags |= CF_CONST; } else { - /* rhs is not constant and already in the primary register */ + /* rhs is not constant and already in the primary register */ if (MustScale) { - /* lhs is a pointer, scale rhs */ - g_scale (TypeOf (lval2.Type), SizeOf (lval->Type+1)); - } + /* lhs is a pointer, scale rhs */ + g_scale (TypeOf (lval2.Type), CheckedSizeOf (lval->Type+1)); + } } - /* Adjust the rhs to the lhs */ - g_typeadjust (flags, TypeOf (lval2.Type)); + /* Setup the code generator flags */ + lflags |= TypeOf (lval->Type) | CF_FORCECHAR; + rflags |= TypeOf (lval2.Type); + + /* Cast the rhs to the type of the lhs */ + g_typecast (lflags, rflags); /* Output apropriate code */ if (lval->Flags & E_MGLOBAL) { /* Static variable */ - flags |= GlobalModeFlags (lval->Flags); + lflags |= GlobalModeFlags (lval->Flags); if (Gen->Tok == TOK_PLUS_ASSIGN) { - g_addeqstatic (flags, lval->Name, lval->ConstVal, lval2.ConstVal); + g_addeqstatic (lflags, lval->Name, lval->ConstVal, lval2.ConstVal); } else { - g_subeqstatic (flags, lval->Name, lval->ConstVal, lval2.ConstVal); + g_subeqstatic (lflags, lval->Name, lval->ConstVal, lval2.ConstVal); } } else if (lval->Flags & E_MLOCAL) { /* ref to localvar */ if (Gen->Tok == TOK_PLUS_ASSIGN) { - g_addeqlocal (flags, lval->ConstVal, lval2.ConstVal); + g_addeqlocal (lflags, lval->ConstVal, lval2.ConstVal); } else { - g_subeqlocal (flags, lval->ConstVal, lval2.ConstVal); + g_subeqlocal (lflags, lval->ConstVal, lval2.ConstVal); } } else if (lval->Flags & E_MCONST) { /* ref to absolute address */ - flags |= CF_ABSOLUTE; + lflags |= CF_ABSOLUTE; if (Gen->Tok == TOK_PLUS_ASSIGN) { - g_addeqstatic (flags, lval->ConstVal, 0, lval2.ConstVal); + g_addeqstatic (lflags, lval->ConstVal, 0, lval2.ConstVal); } else { - g_subeqstatic (flags, lval->ConstVal, 0, lval2.ConstVal); + g_subeqstatic (lflags, lval->ConstVal, 0, lval2.ConstVal); } } else if (lval->Flags & E_MEXPR) { /* Address in a/x. */ if (Gen->Tok == TOK_PLUS_ASSIGN) { - g_addeqind (flags, lval->ConstVal, lval2.ConstVal); + g_addeqind (lflags, lval->ConstVal, lval2.ConstVal); } else { - g_subeqind (flags, lval->ConstVal, lval2.ConstVal); + g_subeqind (lflags, lval->ConstVal, lval2.ConstVal); } } else { Internal ("Invalid addressing mode"); @@ -2909,83 +2953,6 @@ static void addsubeq (GenDesc* Gen, ExprDesc *lval, int k) -static void Assignment (ExprDesc* lval) -/* Parse an assignment */ -{ - int k; - ExprDesc lval2; - unsigned flags; - type* ltype = lval->Type; - - /* Check for assignment to const */ - if (IsQualConst (ltype)) { - Error ("Assignment to const"); - } - - /* cc65 does not have full support for handling structs by value. Since - * assigning structs is one of the more useful operations from this - * family, allow it here. - */ - if (IsClassStruct (ltype)) { - - /* Bring the address of the lhs into the primary and push it */ - exprhs (0, 0, lval); - g_push (CF_PTR | CF_UNSIGNED, 0); - - /* Get the expression on the right of the '=' into the primary */ - k = hie1 (&lval2); - if (k) { - /* Get the address */ - exprhs (0, 0, &lval2); - } else { - /* We need an lvalue */ - Error ("Invalid lvalue in assignment"); - } - - /* Push the address (or whatever is in ax in case of errors) */ - g_push (CF_PTR | CF_UNSIGNED, 0); - - /* Check for equality of the structs */ - if (TypeCmp (ltype, lval2.Type) < TC_EQUAL) { - Error ("Incompatible types"); - } - - /* Load the size of the struct into the primary */ - g_getimmed (CF_INT | CF_UNSIGNED | CF_CONST, SizeOf (ltype), 0); - - /* Call the memcpy function */ - g_call (CF_FIXARGC, "memcpy", 4); - - } else { - - /* Get the address on stack if needed */ - PushAddr (lval); - - /* No struct, setup flags for the load */ - flags = SizeOf (ltype) == 1? CF_FORCECHAR : CF_NONE; - - /* Get the expression on the right of the '=' into the primary */ - if (evalexpr (flags, hie1, &lval2) == 0) { - /* Constant expression. Adjust the types */ - assignadjust (ltype, &lval2); - /* Put the value into the primary register */ - lconst (flags, &lval2); - } else { - /* Expression is not constant and already in the primary */ - assignadjust (ltype, &lval2); - } - - /* Generate a store instruction */ - store (lval); - - } - - /* Value is still in primary */ - lval->Flags = E_MEXPR; -} - - - int hie1 (ExprDesc* lval) /* Parse first level of expression hierarchy. */ { @@ -3055,7 +3022,7 @@ int hie1 (ExprDesc* lval) -int hie0 (ExprDesc *lval) +static int hie0 (ExprDesc *lval) /* Parse comma operator. */ { int k; @@ -3093,7 +3060,7 @@ int evalexpr (unsigned flags, int (*f) (ExprDesc*), ExprDesc* lval) -int expr (int (*func) (ExprDesc*), ExprDesc *lval) +static int expr (int (*func) (ExprDesc*), ExprDesc *lval) /* Expression parser; func is either hie0 or hie1. */ { int k; @@ -3121,7 +3088,7 @@ void expression1 (ExprDesc* lval) * the primary register */ { - memset (lval, 0, sizeof (*lval)); + InitExprDesc (lval); exprhs (CF_NONE, expr (hie1, lval), lval); } @@ -3130,102 +3097,109 @@ void expression1 (ExprDesc* lval) void expression (ExprDesc* lval) /* Evaluate an expression and put it into the primary register */ { - memset (lval, 0, sizeof (*lval)); + InitExprDesc (lval); exprhs (CF_NONE, expr (hie0, lval), lval); } -void constexpr (ExprDesc* lval) +void ConstExpr (ExprDesc* lval) /* Get a constant value */ { - memset (lval, 0, sizeof (*lval)); + InitExprDesc (lval); if (expr (hie1, lval) != 0 || (lval->Flags & E_MCONST) == 0) { Error ("Constant expression expected"); /* To avoid any compiler errors, make the expression a valid const */ - MakeConstIntExpr (lval, 1); + MakeConstIntExpr (lval, 1); } } -void intexpr (ExprDesc* lval) -/* Get an integer expression */ +void ConstIntExpr (ExprDesc* Val) +/* Get a constant int value */ { - expression (lval); - if (!IsClassInt (lval->Type)) { - Error ("Integer expression expected"); - /* To avoid any compiler errors, make the expression a valid int */ - MakeConstIntExpr (lval, 1); + InitExprDesc (Val); + if (expr (hie1, Val) != 0 || + (Val->Flags & E_MCONST) == 0 || + !IsClassInt (Val->Type)) { + Error ("Constant integer expression expected"); + /* To avoid any compiler errors, make the expression a valid const */ + MakeConstIntExpr (Val, 1); } } -void boolexpr (ExprDesc* lval) -/* Get a boolean expression */ +void intexpr (ExprDesc* lval) +/* Get an integer expression */ { - /* Read an expression */ expression (lval); - - /* If it's an integer, it's ok. If it's not an integer, but a pointer, - * the pointer used in a boolean context is also ok - */ - if (!IsClassInt (lval->Type) && !IsClassPtr (lval->Type)) { - Error ("Boolean expression expected"); - /* To avoid any compiler errors, make the expression a valid int */ - MakeConstIntExpr (lval, 1); + if (!IsClassInt (lval->Type)) { + Error ("Integer expression expected"); + /* To avoid any compiler errors, make the expression a valid int */ + MakeConstIntExpr (lval, 1); } } -void test (unsigned label, int cond) -/* Generate code to perform test and jump if false. */ +void Test (unsigned Label, int Invert) +/* Evaluate a boolean test expression and jump depending on the result of + * the test and on Invert. + */ { int k; ExprDesc lval; - /* Eat the parenthesis */ - ConsumeLParen (); + /* Evaluate the expression */ + k = expr (hie0, InitExprDesc (&lval)); - /* Prepare the expression, setup labels */ - memset (&lval, 0, sizeof (lval)); + /* Check for a boolean expression */ + CheckBoolExpr (&lval); - /* Generate code to eval the expr */ - k = expr (hie0, &lval); + /* Check for a constant expression */ if (k == 0 && lval.Flags == E_MCONST) { + /* Constant rvalue */ - if (cond == 0 && lval.ConstVal == 0) { - g_jump (label); + if (!Invert && lval.ConstVal == 0) { + g_jump (Label); Warning ("Unreachable code"); - } else if (cond && lval.ConstVal) { - g_jump (label); + } else if (Invert && lval.ConstVal != 0) { + g_jump (Label); } - ConsumeRParen (); - return; - } - /* If the expr hasn't set condition codes, set the force-test flag */ - if ((lval.Test & E_CC) == 0) { - lval.Test |= E_FORCETEST; - } + } else { - /* Load the value into the primary register */ - exprhs (CF_FORCECHAR, k, &lval); + /* If the expr hasn't set condition codes, set the force-test flag */ + if ((lval.Test & E_CC) == 0) { + lval.Test |= E_FORCETEST; + } - /* Generate the jump */ - if (cond) { - g_truejump (CF_NONE, label); - } else { - /* Special case (putting this here is a small hack - but hey, the - * compiler itself is one big hack...): If a semicolon follows, we - * don't have a statement and may omit the jump. - */ - if (CurTok.Tok != TOK_SEMI) { - g_falsejump (CF_NONE, label); - } + /* Load the value into the primary register */ + exprhs (CF_FORCECHAR, k, &lval); + + /* Generate the jump */ + if (Invert) { + g_truejump (CF_NONE, Label); + } else { + g_falsejump (CF_NONE, Label); + } } +} + + + +void TestInParens (unsigned Label, int Invert) +/* Evaluate a boolean test expression in parenthesis and jump depending on + * the result of the test * and on Invert. + */ +{ + /* Eat the parenthesis */ + ConsumeLParen (); + + /* Do the test */ + Test (Label, Invert); /* Check for the closing brace */ ConsumeRParen (); @@ -3233,4 +3207,3 @@ void test (unsigned label, int cond) -