/* Function epilogue */
{
/* How many bytes of locals do we have to drop? */
- int k = -StackPtr;
+ unsigned k = (unsigned) -StackPtr;
/* If we didn't have a variable argument list, don't call leave */
if (funcargs >= 0) {
- /* Drop stackframe if needed */
+ /* Drop stackframe if needed. We can only drop 255 bytes at a time. */
k += funcargs;
- if (k > 0) {
- if (k <= 8) {
- AddCodeLine ("jsr incsp%d", k);
+ while (k > 0) {
+ unsigned ToDrop = (k > 255)? 255 : k;
+ if (ToDrop <= 8) {
+ AddCodeLine ("jsr incsp%d", k);
} else {
- CheckLocalOffs (k);
- ldyconst (k);
- AddCodeLine ("jsr addysp");
+ ldyconst (ToDrop);
+ AddCodeLine ("jsr addysp");
}
+ k -= ToDrop;
}
} else {
AddCodeLine ("jsr leave");
} else {
/* We've a stack frame to drop */
+ while (k > 255) {
+ ldyconst (255);
+ AddCodeLine ("jsr addysp");
+ k -= 255;
+ }
ldyconst (k);
AddCodeLine ("jsr leavey");
}
-/*****************************************************************************/
-/* Inlined known functions */
-/*****************************************************************************/
-
-
-
-void g_strlen (unsigned flags, unsigned long val, long offs)
-/* Inline the strlen() function */
-{
- /* We need a label in both cases */
- unsigned label = GetLocalLabel ();
-
- /* Two different encodings */
- if (flags & CF_CONST) {
-
- /* The address of the string is constant. Create the correct label name */
- const char* lbuf = GetLabelName (flags, val, offs);
-
- /* Generate the strlen code */
- AddCodeLine ("ldy #$FF");
- g_defcodelabel (label);
- AddCodeLine ("iny");
- AddCodeLine ("lda %s,y", lbuf);
- AddCodeLine ("bne %s", LocalLabelName (label));
- AddCodeLine ("tax");
- AddCodeLine ("tya");
-
- } else {
-
- /* Address not constant but in primary */
- if (CodeSizeFactor < 400) {
- /* This is too much code, so call strlen instead of inlining */
- AddCodeLine ("jsr _strlen");
- } else {
- /* Inline the function */
- AddCodeLine ("sta ptr1");
- AddCodeLine ("stx ptr1+1");
- AddCodeLine ("ldy #$FF");
- g_defcodelabel (label);
- AddCodeLine ("iny");
- AddCodeLine ("lda (ptr1),y");
- AddCodeLine ("bne %s", LocalLabelName (label));
- AddCodeLine ("tax");
- AddCodeLine ("tya");
- }
- }
-}
-
-
-
-/*****************************************************************************/
-/* Inlined known functions */
-/*****************************************************************************/
-
-
-
-void g_strlen (unsigned flags, unsigned long val, long offs);
-/* Inline the strlen() function */
-
-
-
/* End of codegen.h */
#endif
Expr->Test &= ~E_FORCETEST;
}
}
-
-#if 0
- /* Regardless of the original contents, Expr is now an rvalue in the
- * primary. ### Later...
- */
- ED_MakeRValExpr (Expr);
-#endif
}
{
FuncDesc* Func; /* Function descriptor */
int IsFuncPtr; /* Flag */
+ int StdFunc; /* Standard function index */
unsigned ParamSize; /* Number of parameter bytes */
CodeMark Mark = 0; /* Initialize to keep gcc silent */
int PtrOffs = 0; /* Offset of function pointer on stack */
}
/* Check for known standard functions and inline them if requested */
- } else if (IS_Get (&InlineStdFuncs) && IsStdFunc ((const char*) Expr->Name)) {
+ } else if (IS_Get (&InlineStdFuncs) &&
+ (StdFunc = FindStdFunc ((const char*) Expr->Name)) >= 0) {
/* Inline this function */
- HandleStdFunc (Func, Expr);
- goto ExitPoint;
+ HandleStdFunc (StdFunc, Func, Expr);
+ return;
}
*/
if (ParamSize == 0) {
RemoveCode (Mark);
- pop (CF_PTR);
+ pop (CF_PTR);
PtrOnStack = 0;
} else {
/* Load from the saved copy */
}
-ExitPoint:
/* The function result is an rvalue in the primary register */
ED_MakeRValExpr (Expr);
Expr->Type = GetFuncReturn (Expr->Type);
* portion of the index (which is in (e)ax, so there's no further
* action required).
*/
- g_scale (CF_INT | CF_UNSIGNED, CheckedSizeOf (ElementType));
+ g_scale (CF_INT, CheckedSizeOf (ElementType));
} else {
/* The array base address is on stack and the subscript is in the
* primary. Add both.
*/
- g_add (CF_INT | CF_UNSIGNED, 0);
+ g_add (CF_INT, 0);
} else {
} else {
if (ED_IsLocAbs (Expr)) {
/* Constant numeric address. Just add it */
- g_inc (CF_INT | CF_UNSIGNED, Expr->Val);
+ g_inc (CF_INT, Expr->Val);
} else if (ED_IsLocStack (Expr)) {
/* Base address is a local variable address */
if (IsTypeArray (Expr->Type)) {
+/* common */
+#include "xsprintf.h"
+
/* cc65 */
+#include "asmlabel.h"
#include "datatype.h"
+#include "error.h"
#include "symentry.h"
#include "exprdesc.h"
+const char* ED_GetLabelName (const ExprDesc* Expr, long Offs)
+/* Return the assembler label name of the given expression. Beware: This
+ * function may use a static buffer, so the name may get "lost" on the second
+ * call to the function.
+ */
+{
+ static char Buf[256];
+
+ /* Expr may have it's own offset, adjust Offs accordingly */
+ Offs += Expr->Val;
+
+ /* Generate a label depending on the location */
+ switch (ED_GetLoc (Expr)) {
+
+ case E_LOC_ABS:
+ /* Absolute: numeric address or const */
+ xsprintf (Buf, sizeof (Buf), "$%04X", (int)(Offs & 0xFFFF));
+ break;
+
+ case E_LOC_GLOBAL:
+ case E_LOC_STATIC:
+ /* Global or static variable */
+ if (Offs) {
+ xsprintf (Buf, sizeof (Buf), "%s%+ld",
+ SymGetAsmName (Expr->Sym), Offs);
+ } else {
+ xsprintf (Buf, sizeof (Buf), "%s",
+ SymGetAsmName (Expr->Sym));
+ }
+ break;
+
+ case E_LOC_REGISTER:
+ /* Register variable */
+ xsprintf (Buf, sizeof (Buf), "regbank+%u",
+ (unsigned)(Offs & 0xFFFFU));
+ break;
+
+ case E_LOC_LITERAL:
+ /* Literal in the literal pool */
+ if (Offs) {
+ xsprintf (Buf, sizeof (Buf), "%s%+ld",
+ LocalLabelName (Expr->Name), Offs);
+ } else {
+ xsprintf (Buf, sizeof (Buf), "%s",
+ LocalLabelName (Expr->Name));
+ }
+ break;
+
+ default:
+ Internal ("Invalid location in ED_GetLabelName: 0x%04X", ED_GetLoc (Expr));
+ }
+
+ /* Return a pointer to the static buffer */
+ return Buf;
+}
+
+
+
ExprDesc* ED_MakeConstAbs (ExprDesc* Expr, long Value, type* Type)
/* Make Expr an absolute const with the given value and type. */
{
# define ED_IsLocAbs(Expr) (((Expr)->Flags & E_MASK_LOC) == E_LOC_ABS)
#endif
+#if defined(HAVE_INLINE)
+INLINE int ED_IsLocRegister (const ExprDesc* Expr)
+/* Return true if the expression is located in a register */
+{
+ return (Expr->Flags & E_MASK_LOC) == E_LOC_REGISTER;
+}
+#else
+# define ED_IsLocRegister(Expr) (((Expr)->Flags & E_MASK_LOC) == E_LOC_REGISTER)
+#endif
+
#if defined(HAVE_INLINE)
INLINE int ED_IsLocStack (const ExprDesc* Expr)
/* Return true if the expression is located on the stack */
# define ED_IsLocStack(Expr) (((Expr)->Flags & E_MASK_LOC) == E_LOC_STACK)
#endif
+#if defined(HAVE_INLINE)
+INLINE int ED_IsLocPrimary (const ExprDesc* Expr)
+/* Return true if the expression is an expression in the register pseudo variable */
+{
+ return (Expr->Flags & E_MASK_LOC) == E_LOC_PRIMARY;
+}
+#else
+# define ED_IsLocExpr(Expr) (((Expr)->Flags & E_MASK_LOC) == E_LOC_PRIMARY)
+#endif
+
#if defined(HAVE_INLINE)
INLINE int ED_IsLocExpr (const ExprDesc* Expr)
/* Return true if the expression is an expression in the primary */
# define ED_IsLocExpr(Expr) (((Expr)->Flags & E_MASK_LOC) == E_LOC_EXPR)
#endif
+#if defined(HAVE_INLINE)
+INLINE int ED_IsLocLiteral (const ExprDesc* Expr)
+/* Return true if the expression is a string from the literal pool */
+{
+ return (Expr->Flags & E_MASK_LOC) == E_LOC_LITERAL;
+}
+#else
+# define ED_IsLocLiteral(Expr) (((Expr)->Flags & E_MASK_LOC) == E_LOC_LITERAL)
+#endif
+
#if defined(HAVE_INLINE)
INLINE int ED_IsLocConst (const ExprDesc* Expr)
/* Return true if the expression is a constant location of some sort */
# define ED_MakeRVal(Expr) do { (Expr)->Flags &= ~E_RTYPE_LVAL; } while (0)
#endif
+const char* ED_GetLabelName (const ExprDesc* Expr, long Offs);
+/* Return the assembler label name of the given expression. Beware: This
+ * function may use a static buffer, so the name may get "lost" on the second
+ * call to the function.
+ */
+
ExprDesc* ED_MakeConstAbs (ExprDesc* Expr, long Value, type* Type);
/* Make Expr an absolute const with the given value and type. */
unsigned char DebugInfo = 0; /* Add debug info to the obj */
unsigned char CreateDep = 0; /* Create a dependency file */
unsigned char ANSI = 0; /* Strict ANSI flag */
-unsigned char WriteableStrings = 0; /* Literal strings are r/w */
unsigned char NoWarn = 0; /* Suppress warnings */
unsigned char Optimize = 0; /* Optimize flag */
unsigned long OptDisable = 0; /* Optimizer passes to disable */
unsigned RegisterSpace = 6; /* Space available for register vars */
/* Stackable options */
+IntStack WritableStrings = INTSTACK(0); /* Literal strings are r/w */
IntStack InlineStdFuncs = INTSTACK(0); /* Inline some known functions */
IntStack EnableRegVars = INTSTACK(0); /* Enable register variables */
IntStack AllowRegVarAddr = INTSTACK(0); /* Allow taking addresses of register vars */
extern unsigned char DebugInfo; /* Add debug info to the obj */
extern unsigned char CreateDep; /* Create a dependency file */
extern unsigned char ANSI; /* Strict ANSI flag */
-extern unsigned char WriteableStrings; /* Literal strings are r/w */
extern unsigned char NoWarn; /* Suppress warnings */
extern unsigned char Optimize; /* Optimize flag */
extern unsigned long OptDisable; /* Optimizer passes to disable */
extern unsigned RegisterSpace; /* Space available for register vars */
/* Stackable options */
+extern IntStack WritableStrings; /* Literal strings are r/w */
extern IntStack InlineStdFuncs; /* Inline some known functions */
extern IntStack EnableRegVars; /* Enable register variables */
extern IntStack AllowRegVarAddr; /* Allow taking addresses of register vars */
/* */
/* */
/* */
-/* (C) 1998 Ullrich von Bassewitz */
-/* Wacholderweg 14 */
-/* D-70597 Stuttgart */
-/* EMail: uz@musoftware.de */
+/* (C) 1998-2004 Ullrich von Bassewitz */
+/* RömerstraĂŸe 52 */
+/* D-70794 Filderstadt */
+/* EMail: uz@cc65.org */
/* */
/* */
/* This software is provided 'as-is', without any expressed or implied */
}
/* Switch to the data segment */
- if (WriteableStrings) {
+ if (IS_Get (&WritableStrings)) {
g_usedata ();
} else {
g_userodata ();
/* Copy the string starting at Offs and lasting to the end of the buffer
* into Target.
*/
-{
+{
CHECK (Offs <= SB_GetLen (&LiteralPool));
SB_Slice (Target, &LiteralPool, Offs, SB_GetLen (&LiteralPool) - Offs);
}
" --static-locals\tMake local variables static\n"
" --target sys\t\tSet the target system\n"
" --verbose\t\tIncrease verbosity\n"
- " --version\t\tPrint the compiler version number\n",
+ " --version\t\tPrint the compiler version number\n"
+ " --writable-strings\tMake string literals writable\n",
ProgName);
}
+static void OptWritableStrings (const char* Opt attribute ((unused)),
+ const char* Arg attribute ((unused)))
+/* Make string literals writable */
+{
+ IS_Set (&WritableStrings, 1);
+}
+
+
+
int main (int argc, char* argv[])
{
/* Program long options */
{ "--target", 1, OptTarget },
{ "--verbose", 0, OptVerbose },
{ "--version", 0, OptVersion },
+ { "--writable-strings", 0, OptWritableStrings },
};
unsigned I;
#include "check.h"
/* cc65 */
+#include "asmlabel.h"
#include "codegen.h"
#include "error.h"
#include "funcdesc.h"
/*****************************************************************************/
-/* Function forwards */
+/* Function forwards */
/*****************************************************************************/
/*****************************************************************************/
-/* Data */
+/* Data */
/*****************************************************************************/
*/
static struct StdFuncDesc {
const char* Name;
- void (*Handler) (FuncDesc*, ExprDesc*);
-} StdFuncs [] = {
+ void (*Handler) (FuncDesc*, ExprDesc*);
+} StdFuncs[] = {
{ "memset", StdFunc_memset },
{ "strlen", StdFunc_strlen },
};
-#define FUNC_COUNT (sizeof (StdFuncs) / sizeof (StdFuncs [0]))
+#define FUNC_COUNT (sizeof (StdFuncs) / sizeof (StdFuncs[0]))
+
/*****************************************************************************/
-static struct StdFuncDesc* FindFunc (const char* Name)
-/* Find a function with the given name. Return a pointer to the descriptor if
- * found, return NULL otherwise.
- */
-{
- return bsearch (Name, StdFuncs, FUNC_COUNT, sizeof (StdFuncs [0]), CmpFunc);
-}
-
-
-
static unsigned ParseArg (type* Type, ExprDesc* Arg)
/* Parse one argument but do not push it onto the stack. Return the code
* generator flags needed to do the actual push.
-static void StdFunc_memset (FuncDesc* F attribute ((unused)),
- ExprDesc* lval attribute ((unused)))
+static void StdFunc_memset (FuncDesc* F attribute ((unused)), ExprDesc* Expr)
/* Handle the memset function */
{
/* Argument types */
/* We expect the closing brace */
ConsumeRParen ();
+
+ /* The function result is an rvalue in the primary register */
+ ED_MakeRValExpr (Expr);
+ Expr->Type = GetFuncReturn (Expr->Type);
}
-static void StdFunc_strlen (FuncDesc* F attribute ((unused)),
- ExprDesc* lval attribute ((unused)))
+static void StdFunc_strlen (FuncDesc* F attribute ((unused)), ExprDesc* Expr)
/* Handle the strlen function */
{
- static type ParamType[] = { T_PTR, T_SCHAR, T_END };
- ExprDesc Param;
- unsigned CodeFlags;
- unsigned long ParamName;
+ static type ArgType[] = { T_PTR, T_SCHAR, T_END };
+ ExprDesc Arg;
+ unsigned L;
+
/* Setup the argument type string */
- ParamType[1] = GetDefaultChar () | T_QUAL_CONST;
+ ArgType[1] = GetDefaultChar () | T_QUAL_CONST;
- /* Fetch the parameter and convert it to the type needed */
- hie1 (&Param);
- TypeConversion (&Param, ParamType);
+ /* Evaluate the parameter */
+ hie1 (&Arg);
+
+ /* We can generate special code for several locations */
+ if (ED_IsLocConst (&Arg) && IsTypeArray (Arg.Type)) {
+
+ /* Do type conversion */
+ TypeConversion (&Arg, ArgType);
+
+ /* If the expression is a literal, and if string literals are read
+ * only, we can calculate the length of the string and remove it
+ * from the literal pool. Otherwise we have to calculate the length
+ * at runtime.
+ */
+ if (ED_IsLocLiteral (&Arg) && IS_Get (&WritableStrings)) {
+
+ /* Constant string literal */
+ ED_MakeConstAbs (Expr, strlen (GetLiteral (Arg.Val)), type_size_t);
+ ResetLiteralPoolOffs (Arg.Val);
+
+ } else {
+
+ /* Generate the strlen code */
+ L = GetLocalLabel ();
+ AddCodeLine ("ldy #$FF");
+ g_defcodelabel (L);
+ AddCodeLine ("iny");
+ AddCodeLine ("lda %s,y", ED_GetLabelName (&Arg, 0));
+ AddCodeLine ("bne %s", LocalLabelName (L));
+ AddCodeLine ("tax");
+ AddCodeLine ("tya");
+
+ /* The function result is an rvalue in the primary register */
+ ED_MakeRValExpr (Expr);
+ Expr->Type = type_size_t;
- /* Check if the parameter is a constant array of some type, or a numeric
- * address cast to a pointer.
- */
- CodeFlags = 0;
- ParamName = Param.Name;
- if ((ED_IsLocConst (&Param) && IsTypeArray (Param.Type)) ||
- (ED_IsLocAbs (&Param) && IsTypePtr (Param.Type))) {
-
- /* Check which type of constant it is */
- switch (ED_GetLoc (&Param)) {
-
- case E_LOC_ABS:
- /* Numerical address */
- CodeFlags |= CF_CONST | CF_ABSOLUTE;
- break;
-
- case E_LOC_GLOBAL:
- /* Global label */
- CodeFlags |= CF_CONST | CF_EXTERNAL;
- break;
-
- case E_LOC_STATIC:
- /* Local symbol */
- CodeFlags |= CF_CONST | CF_STATIC;
- break;
-
- case E_LOC_REGISTER:
- /* Register variable */
- CodeFlags |= CF_CONST | CF_REGVAR;
- break;
-
- case E_LOC_LITERAL:
- /* A literal of some kind. If string literals are read only,
- * we can calculate the length of the string and remove it
- * from the literal pool. Otherwise we have to calculate the
- * length at runtime.
- */
- if (!WriteableStrings) {
- /* String literals are const */
- ExprDesc Length;
- ED_MakeConstAbsInt (&Length, strlen (GetLiteral (Param.Val)));
- ResetLiteralPoolOffs (Param.Val);
- ExprLoad (CF_NONE, &Length);
- goto ExitPoint;
- } else {
- CodeFlags |= CF_CONST | CF_STATIC;
- ParamName = LiteralPoolLabel;
- }
- break;
-
- default:
- Internal ("Unknown constant type: %04X", Param.Flags);
}
+ } else if (ED_IsLocStack (&Arg) && StackPtr >= -255 && IsTypeArray (Arg.Type)) {
+
+ /* Calculate the true stack offset */
+ unsigned Offs = (unsigned) (Arg.Val - StackPtr);
+
+ /* Do type conversion */
+ TypeConversion (&Arg, ArgType);
+
+ /* Generate the strlen code */
+ L = GetLocalLabel ();
+ AddCodeLine ("ldx #$FF");
+ AddCodeLine ("ldy #$%02X", (unsigned char) (Offs-1));
+ g_defcodelabel (L);
+ AddCodeLine ("inx");
+ AddCodeLine ("iny");
+ AddCodeLine ("lda (sp),y");
+ AddCodeLine ("bne %s", LocalLabelName (L));
+ AddCodeLine ("txa");
+ AddCodeLine ("ldx #$00");
+
+ /* The function result is an rvalue in the primary register */
+ ED_MakeRValExpr (Expr);
+ Expr->Type = type_size_t;
+
+ } else if (ED_IsLocRegister (&Arg) && ED_IsLVal (&Arg) && IsTypePtr (Arg.Type)) {
+
+ /* Do type conversion */
+ TypeConversion (&Arg, ArgType);
+
+ /* Generate the strlen code */
+ L = GetLocalLabel ();
+ AddCodeLine ("ldy #$FF");
+ g_defcodelabel (L);
+ AddCodeLine ("iny");
+ AddCodeLine ("lda (%s),y", ED_GetLabelName (&Arg, 0));
+ AddCodeLine ("bne %s", LocalLabelName (L));
+ AddCodeLine ("tax");
+ AddCodeLine ("tya");
+
+ /* The function result is an rvalue in the primary register */
+ ED_MakeRValExpr (Expr);
+ Expr->Type = type_size_t;
+
} else {
- /* Not an array with a constant address. Load parameter into primary */
- ExprLoad (CF_NONE, &Param);
+ /* Do type conversion */
+ TypeConversion (&Arg, ArgType);
- }
+ /* Load the expression into the primary */
+ ExprLoad (CF_NONE, &Arg);
+
+ /* Call the strlen function */
+ AddCodeLine ("jsr _%s", Func_strlen);
- /* Generate the strlen code */
- g_strlen (CodeFlags, ParamName, Param.Val);
+ /* The function result is an rvalue in the primary register */
+ ED_MakeRValExpr (Expr);
+ Expr->Type = type_size_t;
+
+ }
-ExitPoint:
/* We expect the closing brace */
ConsumeRParen ();
}
-int IsStdFunc (const char* Name)
+int FindStdFunc (const char* Name)
/* Determine if the given function is a known standard function that may be
- * called in a special way.
+ * called in a special way. If so, return the index, otherwise return -1.
*/
{
/* Look into the table for known names */
- return FindFunc (Name) != 0;
+ struct StdFuncDesc* D =
+ bsearch (Name, StdFuncs, FUNC_COUNT, sizeof (StdFuncs[0]), CmpFunc);
+
+ /* Return the function index or -1 */
+ if (D == 0) {
+ return -1;
+ } else {
+ return D - StdFuncs;
+ }
}
-void HandleStdFunc (FuncDesc* F, ExprDesc* lval)
+void HandleStdFunc (int Index, FuncDesc* F, ExprDesc* lval)
/* Generate code for a known standard function. */
{
+ struct StdFuncDesc* D;
+
/* Get a pointer to the table entry */
- struct StdFuncDesc* D = FindFunc ((const char*) lval->Name);
- CHECK (D != 0);
+ CHECK (Index >= 0 && Index < (int)FUNC_COUNT);
+ D = StdFuncs + Index;
/* Call the handler function */
D->Handler (F, lval);
/* */
/* */
/* */
-/* (C) 1998-2002 Ullrich von Bassewitz */
-/* Wacholderweg 14 */
-/* D-70597 Stuttgart */
-/* EMail: uz@musoftware.de */
+/* (C) 1998-2004 Ullrich von Bassewitz */
+/* Römerstrasse 52 */
+/* D-70794 Filderstadt */
+/* EMail: uz@cc65.org */
/* */
/* */
/* This software is provided 'as-is', without any expressed or implied */
-int IsStdFunc (const char* Name);
+int FindStdFunc (const char* Name);
/* Determine if the given function is a known standard function that may be
- * called in a special way.
+ * called in a special way. If so, return the index, otherwise return -1.
*/
-void HandleStdFunc (struct FuncDesc* F, ExprDesc* lval);
+void HandleStdFunc (int Index, struct FuncDesc* F, ExprDesc* lval);
/* Generate code for a known standard function. */
+const char Func__bzero[] = "_bzero"; /* Asm name of "_bzero" */
const char Func_memcpy[] = "memcpy"; /* Asm name of "memcpy" */
const char Func_memset[] = "memset"; /* Asm name of "memset" */
-const char Func__bzero[] = "_bzero"; /* Asm name of "_bzero */
+const char Func_strlen[] = "strlen"; /* Asm name of "strlen" */
/*****************************************************************************/
-
+
+extern const char Func__bzero[]; /* Asm name of "_bzero" */
extern const char Func_memcpy[]; /* Asm name of "memcpy" */
extern const char Func_memset[]; /* Asm name of "memset" */
-extern const char Func__bzero[]; /* Asm name of "_bzero */
+extern const char Func_strlen[]; /* Asm name of "strlen" */
# define SymIsRegVar(Sym) (((Sym)->Flags & (SC_REGISTER|SC_TYPE)) == SC_REGISTER)
#endif
+#if defined(HAVE_INLINE)
+INLINE const char* SymGetAsmName (const SymEntry* Sym)
+/* Return the assembler label name for the symbol (beware: may be NULL!) */
+{
+ return Sym->AsmName;
+}
+#else
+# define SymGetAsmName(Sym) ((Sym)->AsmName)
+#endif
+
void CvtRegVarToAuto (SymEntry* Sym);
/* Convert a register variable to an auto variable */
-static void DoConversion (ExprDesc* Expr, type* NewType)
+static void DoConversion (ExprDesc* Expr, const type* NewType)
/* Emit code to convert the given expression to a new type. */
{
type* OldType;