/* "p2c", a Pascal to C translator.
   Copyright (C) 1989 David Gillespie.
   Author's address: daveg@csvax.caltech.edu; 256-80 Caltech/Pasadena CA 91125.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation (any version).

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

#define PROTO_DECL5_C
#include "trans.h"

#define MAXIMPORTS 100

extern struct ptrdesc {
    struct ptrdesc *next;
    Symbol *sym;
    Type *tp;
} *ptrbase;

extern struct ctxstack {
    struct ctxstack *next;
    Meaning *ctx, *ctxlast;
    struct tempvarlist *tempvars;
    int tempvarcount, importmark;
} *ctxtop;

extern struct tempvarlist {
    struct tempvarlist *next;
    Meaning *tvar;
    int active;
} *tempvars, *stmttempvars;

extern int tempvarcount;

extern int stringtypecachesize;
extern Type **stringtypecache;

extern Meaning *importlist[MAXIMPORTS];
extern int firstimport;

extern Type *tp_special_anyptr;

extern int wasaliased;
extern int deferallptrs;
extern int anydeferredptrs;
extern int silentalreadydef;
extern int nonloclabelcount;

extern Strlist *varstructdecllist;

void p_labeldecl()
{
    Symbol *sp;
    Meaning *mp;

    do {
        gettok();
        if (curtok != TOK_IDENT)
            wexpecttok(TOK_INTLIT);
        sp = findlabelsym();
        mp = addmeaning(curtoksym, MK_LABEL);
	mp->val.i = 0;
	mp->xnext = addmeaning(findsymbol(format_s(name_LABVAR,
						   mp->name)),
			       MK_VAR);
	mp->xnext->type = tp_jmp_buf;
	mp->xnext->refcount = 0;
        gettok();
    } while (curtok == TOK_COMMA);
    if (!wneedtok(TOK_SEMI))
	skippasttoken(TOK_SEMI);
}





Meaning *findfieldname(sym, variants, nvars)
Symbol *sym;
Meaning **variants;
int *nvars;
{
    Meaning *mp, *mp0;

    mp = variants[*nvars-1];
    while (mp && mp->kind == MK_FIELD) {
        if (mp->sym == sym) {
            return mp;
        }
        mp = mp->cnext;
    }
    while (mp) {
        variants[(*nvars)++] = mp->ctx;
        mp0 = findfieldname(sym, variants, nvars);
        if (mp0)
            return mp0;
        (*nvars)--;
        while (mp->cnext && mp->cnext->ctx == mp->ctx)
            mp = mp->cnext;
        mp = mp->cnext;
    }
    return NULL;
}




Expr *p_constrecord(type, style)
Type *type;
int style;   /* 0=HP, 1=Turbo, 2=Oregon+VAX */
{
    Meaning *mp, *mp0, *variants[20], *newvariants[20], *curfield;
    Symbol *sym;
    Value val;
    Expr *ex, *cex;
    int i, j, nvars, newnvars, varcounts[20];

    if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
	return makeexpr_long(0);
    cex = makeexpr(EK_STRUCTCONST, 0);
    nvars = 0;
    varcounts[0] = 0;
    curfield = type->fbase;
    for (;;) {
	if (style == 2) {
	    if (curfield) {
		mp = curfield;
		if (mp->kind == MK_VARIANT || mp->isforward) {
		    val = p_constant(mp->type);
		    if (mp->kind == MK_FIELD) {
			insertarg(&cex, cex->nargs, makeexpr_val(val));
			mp = mp->cnext;
		    }
		    val.type = mp->val.type;
		    if (!valuesame(val, mp->val)) {
			while (mp && !valuesame(val, mp->val))
			    mp = mp->cnext;
			if (mp) {
			    note("Attempting to initialize union member other than first [113]");
			    curfield = mp->ctx;
			} else {
			    warning("Tag value does not exist in record [129]");
			    curfield = NULL;
			}
		    } else
			curfield = mp->ctx;
		    goto ignorefield;
		} else {
		    i = cex->nargs;
		    insertarg(&cex, i, NULL);
		    if (mp->isforward && curfield->cnext)
			curfield = curfield->cnext->ctx;
		    else
			curfield = curfield->cnext;
		}
	    } else {
		warning("Too many fields in record constructor [130]");
		ex = p_expr(NULL);
		freeexpr(ex);
		goto ignorefield;
	    }
	} else {
	    if (!wexpecttok(TOK_IDENT)) {
		skiptotoken2(TOK_RPAR, TOK_RBR);
		break;
	    }
	    sym = curtoksym;
	    gettok();
	    if (!wneedtok(TOK_COLON)) {
		skiptotoken2(TOK_RPAR, TOK_RBR);
		break;
	    }
	    newnvars = 1;
	    newvariants[0] = type->fbase;
	    mp = findfieldname(sym, newvariants, &newnvars);
	    if (!mp) {
		warning(format_s("Field %s not in record [131]", sym->name));
		ex = p_expr(NULL);   /* good enough */
		freeexpr(ex);
		goto ignorefield;
	    }
	    for (i = 0; i < nvars && i < newnvars; i++) {
		if (variants[i] != newvariants[i]) {
		    warning("Fields are members of incompatible variants [132]");
		    ex = p_subconst(mp->type, style);
		    freeexpr(ex);
		    goto ignorefield;
		}
	    }
	    while (nvars < newnvars) {
		variants[nvars] = newvariants[nvars];
		if (nvars > 0) {
		    for (mp0 = variants[nvars-1]; mp0->kind != MK_VARIANT; mp0 = mp0->cnext) ;
		    if (mp0->ctx != variants[nvars])
			note("Attempting to initialize union member other than first [113]");
		}
		i = varcounts[nvars];
		for (mp0 = variants[nvars]; mp0 && mp0->kind == MK_FIELD; mp0 = mp0->cnext)
		    i++;
		nvars++;
		varcounts[nvars] = i;
		while (cex->nargs < i)
		    insertarg(&cex, cex->nargs, NULL);
	    }
	    i = varcounts[newnvars-1];
	    for (mp0 = variants[newnvars-1]; mp0->sym != sym; mp0 = mp0->cnext)
		i++;
	    if (cex->args[i])
		warning(format_s("Two constructors for %s [133]", mp->name));
	}
	ex = p_subconst(mp->type, style);
	if (ex->kind == EK_CONST &&
	    (ex->val.type->kind == TK_RECORD ||
	     ex->val.type->kind == TK_ARRAY))
	    ex = (Expr *)ex->val.i;
	cex->args[i] = ex;
ignorefield:
        if (curtok == TOK_COMMA || curtok == TOK_SEMI)
            gettok();
        else
            break;
    }
    if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
	skippasttoken2(TOK_RPAR, TOK_RBR);
    if (style != 2) {
	j = 0;
	mp = variants[0];
	for (i = 0; i < cex->nargs; i++) {
	    while (!mp || mp->kind != MK_FIELD)
		mp = variants[++j];
	    if (!cex->args[i]) {
		warning(format_s("No constructor for %s [134]", mp->name));
		cex->args[i] = makeexpr_name("<oops>", mp->type);
	    }
	    mp = mp->cnext;
	}
    }
    val.type = type;
    val.i = (long)cex;
    val.s = NULL;
    return makeexpr_val(val);
}




Expr *p_constarray(type, style)
Type *type;
int style;
{
    Value val;
    Expr *ex, *cex;
    int nvals, skipped;
    long smin, smax;

    if (type->kind == TK_SMALLARRAY)
        warning("Small-array constructors not yet implemented [135]");
    if (!wneedtok(style ? TOK_LPAR : TOK_LBR))
	return makeexpr_long(0);
    if (type->smin && type->smin->kind == EK_CONST)
        skipped = type->smin->val.i;
    else
        skipped = 0;
    cex = NULL;
    for (;;) {
        if (style && (curtok == TOK_LPAR || curtok == TOK_LBR)) {
            ex = p_subconst(type->basetype, style);
            nvals = 1;
	} else if (curtok == TOK_REPEAT) {
	    gettok();
	    ex = p_expr(type->basetype);
	    if (ord_range(type->indextype, &smin, &smax)) {
		nvals = smax - smin + 1;
		if (cex)
		    nvals -= cex->nargs;
	    } else {
		nvals = 1;
		note("REPEAT not translatable for non-constant array bounds [114]");
	    }
            ex = gentle_cast(ex, type->basetype);
        } else {
            ex = p_expr(type->basetype);
            if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING &&
                ex->val.i > 1 && !skipped && style == 0 && !cex &&
                type->basetype->kind == TK_CHAR &&
                checkconst(type->indextype->smin, 1)) {
                if (!wneedtok(TOK_RBR))
		    skippasttoken2(TOK_RBR, TOK_RPAR);
                return ex;   /* not quite right, but close enough */
            }
            if (curtok == TOK_OF) {
                ex = gentle_cast(ex, tp_integer);
                val = eval_expr(ex);
                freeexpr(ex);
                if (!val.type)
                    warning("Expected a constant [127]");
                nvals = val.i;
                gettok();
                ex = p_expr(type->basetype);
            } else
                nvals = 1;
            ex = gentle_cast(ex, type->basetype);
        }
        nvals += skipped;
        skipped = 0;
        if (ex->kind == EK_CONST &&
            (ex->val.type->kind == TK_RECORD ||
             ex->val.type->kind == TK_ARRAY))
            ex = (Expr *)ex->val.i;
        if (nvals != 1) {
            ex = makeexpr_un(EK_STRUCTOF, type->basetype, ex);
            ex->val.i = nvals;
        }
        if (cex)
            insertarg(&cex, cex->nargs, ex);
        else
            cex = makeexpr_un(EK_STRUCTCONST, type, ex);
        if (curtok == TOK_COMMA)
            gettok();
        else
            break;
    }
    if (!wneedtok(style ? TOK_RPAR : TOK_RBR))
	skippasttoken2(TOK_RPAR, TOK_RBR);
    val.type = type;
    val.i = (long)cex;
    val.s = NULL;
    return makeexpr_val(val);
}




Expr *p_conststring(type, style)
Type *type;
int style;
{
    Expr *ex;
    Token close = (style ? TOK_RPAR : TOK_RBR);

    if (curtok != (style ? TOK_LPAR : TOK_LBR))
	return p_expr(type);
    gettok();
    ex = p_expr(tp_integer);  /* should handle "OF" and "," for constructors */
    if (curtok == TOK_OF || curtok == TOK_COMMA) {
        warning("Multi-element string constructors not yet supported [136]");
	skiptotoken(close);
    }
    if (!wneedtok(close))
	skippasttoken(close);
    return ex;
}




Expr *p_subconst(type, style)
Type *type;
int style;
{
    Value val;

    if (curtok == TOK_IDENT && curtokmeaning &&
	curtokmeaning->kind == MK_TYPE) {
	if (curtokmeaning->type != type)
	    warning("Type conflict in constant [137]");
	gettok();
    }
    if (curtok == TOK_IDENT && !strcicmp(curtokbuf, "ZERO") &&
	!curtokmeaning) {   /* VAX Pascal foolishness */
	gettok();
	if (type->kind == TK_STRING)
	    return makeexpr_string("");
	if (type->kind == TK_REAL)
	    return makeexpr_real("0.0");
	val.type = type;
	if (type->kind == TK_RECORD || type->kind == TK_ARRAY ||
	    type->kind == TK_SET)
	    val.i = (long)makeexpr_un(EK_STRUCTCONST, type, makeexpr_long(0));
	else
	    val.i = 0;
	val.s = NULL;
	return makeexpr_val(val);
    }
    switch (type->kind) {
	
      case TK_RECORD:
	if (curtok == (style ? TOK_LPAR : TOK_LBR))
	    return p_constrecord(type, style);
	break;
	
      case TK_SMALLARRAY:
      case TK_ARRAY:
	if (curtok == (style ? TOK_LPAR : TOK_LBR))
	    return p_constarray(type, style);
	break;
	
      case TK_SMALLSET:
      case TK_SET:
	if (curtok == TOK_LBR)
	    return p_setfactor(type);
	break;
	
      default:
	break;
	
    }
    return gentle_cast(p_expr(type), type);
}



void p_constdecl()
{
    Meaning *mp;
    Expr *ex, *ex2;
    Type *oldtype;
    char savetokcase[sizeof(curtokcase)];
    Symbol *savetoksym;
    Strlist *sl;
    int i, saveindent, outflag = (blockkind != TOK_IMPORT);

    if (outflag)
        outsection(majorspace);
    flushcomments(NULL, -1, -1);
    gettok();
    oldtype = NULL;
    while (curtok == TOK_IDENT) {
        strcpy(savetokcase, curtokcase);
        savetoksym = curtoksym;
        gettok();
        strcpy(curtokcase, savetokcase);   /* what a kludge! */
        curtoksym = savetoksym;
        if (curtok == TOK_COLON) {     /* Turbo Pascal typed constant */
            mp = addmeaning(curtoksym, MK_VAR);
	    decl_comments(mp);
            gettok();
            mp->type = p_type(mp);
            if (wneedtok(TOK_EQ)) {
		if (mp->kind == MK_VARMAC) {
		    freeexpr(p_subconst(mp->type, 1));
		    note("Initializer ignored for variable with VarMacro [115]");
		} else {
		    mp->constdefn = p_subconst(mp->type, 1);
		    if (blockkind == TOK_EXPORT) {
			/*  nothing  */
		    } else {
			mp->isforward = 1;   /* static variable */
		    }
		}
	    }
	    decl_comments(mp);
        } else {
            sl = strlist_find(constmacros, curtoksym->name);
            if (sl) {
                mp = addmeaning(curtoksym, MK_VARMAC);
                mp->constdefn = (Expr *)sl->value;
                strlist_delete(&constmacros, sl);
            } else {
                mp = addmeaning(curtoksym, MK_CONST);
            }
	    decl_comments(mp);
            if (!wexpecttok(TOK_EQ)) {
		skippasttoken(TOK_SEMI);
		continue;
	    }
	    mp->isactive = 0;   /* A fine point indeed (see below) */
	    gettok();
	    if (curtok == TOK_IDENT &&
		curtokmeaning && curtokmeaning->kind == MK_TYPE &&
		(curtokmeaning->type->kind == TK_RECORD ||
		 curtokmeaning->type->kind == TK_SMALLARRAY ||
		 curtokmeaning->type->kind == TK_ARRAY)) {
		oldtype = curtokmeaning->type;
		gettok();
		ex = p_subconst(oldtype, (curtok == TOK_LBR) ? 0 : 2);
	    } else
		ex = p_expr(NULL);
	    mp->isactive = 1;   /* Re-enable visibility of the new constant */
            if (mp->kind == MK_CONST)
                mp->constdefn = ex;
            if (ord_type(ex->val.type)->kind == TK_INTEGER) {
                i = exprlongness(ex);
                if (i > 0)
                    ex->val.type = tp_integer;
		else if (i < 0)
                    ex->val.type = tp_int;
            }
	    decl_comments(mp);
            mp->type = ex->val.type;
            mp->val = eval_expr(ex);
            if (mp->kind == MK_CONST) {
                switch (ex->val.type->kind) {

                    case TK_INTEGER:
                    case TK_BOOLEAN:
                    case TK_CHAR:
                    case TK_ENUM:
                    case TK_SUBR:
                    case TK_REAL:
                        if (foldconsts > 0)
                            mp->anyvarflag = 1;
                        break;

                    case TK_STRING:
                        if (foldstrconsts > 0)
                            mp->anyvarflag = 1;
                        break;

		    default:
			break;
                }
            }
	    flushcomments(&mp->comments, CMT_PRE, -1);
            if (ex->val.type->kind == TK_SET) {
                mp->val.type = NULL;
		if (mp->kind == MK_CONST) {
		    ex2 = makeexpr(EK_MACARG, 0);
		    ex2->val.type = ex->val.type;
		    mp->constdefn = makeexpr_assign(ex2, ex);
		}
            } else if (mp->kind == MK_CONST && outflag) {
                if (ex->val.type != oldtype) {
                    outsection(minorspace);
                    oldtype = ex->val.type;
                }
                switch (ex->val.type->kind) {

                    case TK_ARRAY:
                    case TK_RECORD:
                        select_outfile(codef);
                        outsection(minorspace);
                        if (blockkind == TOK_IMPLEMENT || blockkind == TOK_PROGRAM)
                            output("static ");
                        if (useAnyptrMacros == 1 || useconsts == 2)
                            output("Const ");
                        else if (useconsts > 0)
                            output("const ");
                        outbasetype(mp->type, ODECL_CHARSTAR|ODECL_FREEARRAY);
                        output(" ");
                        outdeclarator(mp->type, mp->name,
				      ODECL_CHARSTAR|ODECL_FREEARRAY);
                        output(" = {");
			outtrailcomment(mp->comments, -1, declcommentindent);
			saveindent = outindent;
			moreindent(tabsize);
			moreindent(structinitindent);
                     /*   if (mp->val.s)
                            output(mp->val.s);
                        else  */
                            out_expr((Expr *)mp->val.i);
                        outindent = saveindent;
                        output("\n};\n");
                        outsection(minorspace);
                        if (blockkind == TOK_EXPORT) {
                            select_outfile(hdrf);
                            if (usevextern)
                                output("vextern ");
                            if (useAnyptrMacros == 1 || useconsts == 2)
                                output("Const ");
                            else if (useconsts > 0)
                                output("const ");
                            outbasetype(mp->type, ODECL_CHARSTAR);
                            output(" ");
                            outdeclarator(mp->type, mp->name, ODECL_CHARSTAR);
                            output(";\n");
                        }
                        break;

                    default:
                        if (foldconsts > 0) break;
                        output(format_s("#define %s", mp->name));
			mp->isreturn = 1;
                        out_spaces(constindent, 0, 0, 0);
			saveindent = outindent;
			outindent = cur_column();
                        out_expr_factor(ex);
			outindent = saveindent;
			outtrailcomment(mp->comments, -1, declcommentindent);
                        break;

                }
            }
	    flushcomments(&mp->comments, -1, -1);
            if (mp->kind == MK_VARMAC)
                freeexpr(ex);
            mp->wasdeclared = 1;
        }
        if (!wneedtok(TOK_SEMI))
	    skippasttoken(TOK_SEMI);
    }
    if (outflag)
        outsection(majorspace);
}




void declaresubtypes(mp)
Meaning *mp;
{
    Meaning *mp2;
    Type *tp;
    struct ptrdesc *pd;

    while (mp) {
	if (mp->kind == MK_VARIANT) {
	    declaresubtypes(mp->ctx);
	} else {
	    tp = mp->type;
	    while (tp->basetype && !tp->meaning && tp->kind != TK_POINTER)
		tp = tp->basetype;
	    if (tp->meaning && !tp->meaning->wasdeclared &&
		(tp->kind == TK_RECORD || tp->kind == TK_ENUM) &&
		tp->meaning->ctx && tp->meaning->ctx != nullctx) {
		pd = ptrbase;   /* Do this now, just in case */
		while (pd) {
		    if (pd->tp->basetype == tp_abyte) {
			mp2 = pd->sym->mbase;
			while (mp2 && !mp2->isactive)
			    mp2 = mp2->snext;
			if (mp2 && mp2->kind == MK_TYPE) {
			    pd->tp->basetype = mp2->type;
			    if (!mp2->type->pointertype)
				mp2->type->pointertype = pd->tp;
			}
		    }
		    pd = pd->next;
		}
		declaretype(tp->meaning);
	    }
	}
	mp = mp->cnext;
    }
}


void declaretype(mp)
Meaning *mp;
{
    int saveindent;

    switch (mp->type->kind) {
	
      case TK_RECORD:
	if (mp->type->meaning != mp) {
	    output(format_ss("typedef %s %s;",
			     mp->type->meaning->name,
			     mp->name));
	} else {
	    declaresubtypes(mp->type->fbase);
	    outsection(minorspace);
	    if (record_is_union(mp->type))
		output("typedef union ");
	    else
		output("typedef struct ");
	    output(format_s("%s {\n", format_s(name_STRUCT, mp->name)));
	    saveindent = outindent;
	    moreindent(tabsize);
	    moreindent(structindent);
	    outfieldlist(mp->type->fbase);
	    outindent = saveindent;
	    output(format_s("} %s;", mp->name));
	}
	outtrailcomment(mp->comments, -1, declcommentindent);
	mp->type->structdefd = 1;
	if (mp->type->meaning == mp)
	    outsection(minorspace);
	break;
	
      case TK_ARRAY:
      case TK_SMALLARRAY:
	output("typedef ");
	if (mp->type->meaning != mp) {
	    output(format_ss("%s %s",
			     mp->type->meaning->name,
			     mp->name));
	} else {
	    outbasetype(mp->type, 0);
	    output(" ");
	    outdeclarator(mp->type, mp->name, 0);
	}
	output(";");
	outtrailcomment(mp->comments, -1, declcommentindent);
	break;
	
      case TK_ENUM:
	if (useenum) {
	    output("typedef ");
	    if (mp->type->meaning != mp)
		output(mp->type->meaning->name);
	    else
		outbasetype(mp->type, 0);
	    output(" ");
	    output(mp->name);
	    output(";");
	    outtrailcomment(mp->comments, -1,
			    declcommentindent);
	}
	break;
	
      default:
	break;
    }
    mp->wasdeclared = 1;
}



void declaretypes(outflag)
int outflag;
{
    Meaning *mp;

    for (mp = curctx->cbase; mp; mp = mp->cnext) {
        if (mp->kind == MK_TYPE && !mp->wasdeclared) {
            if (outflag) {
		flushcomments(&mp->comments, CMT_PRE, -1);
		declaretype(mp);
		flushcomments(&mp->comments, -1, -1);
            }
            mp->wasdeclared = 1;
        }
    }
}


void p_typedecl()
{
    Meaning *mp;
    int outflag = (blockkind != TOK_IMPORT);
    struct ptrdesc *pd;

    if (outflag)
        outsection(majorspace);
    flushcomments(NULL, -1, -1);
    gettok();
    outsection(minorspace);
    deferallptrs = 1;
    anydeferredptrs = 0;
    notephase = 1;
    while (curtok == TOK_IDENT) {
        mp = addmeaning(curtoksym, MK_TYPE);
	mp->type = tp_integer;    /* in case of syntax errors */
        gettok();
	decl_comments(mp);
	if (curtok == TOK_SEMI) {
	    mp->type = tp_anyptr;    /* Modula-2 opaque type */
	} else {
	    if (!wneedtok(TOK_EQ)) {
		skippasttoken(TOK_SEMI);
		continue;
	    }
	    mp->type = p_type(mp);
	    decl_comments(mp);
	    if (!mp->type->meaning)
		mp->type->meaning = mp;
	    if (mp->type->kind == TK_RECORD)
		mp->type->structdefd = 1;
	    if (!anydeferredptrs)
		declaretypes(outflag);
	}
	if (!wneedtok(TOK_SEMI))
	    skippasttoken(TOK_SEMI);
    }
    notephase = 0;
    deferallptrs = 0;
    while (ptrbase) {
        pd = ptrbase;
	if (pd->tp->basetype == tp_abyte) {
	    mp = pd->sym->mbase;
	    while (mp && !mp->isactive)
		mp = mp->snext;
	    if (!mp || mp->kind != MK_TYPE) {
		warning(format_s("Unsatisfied forward reference to type %s [138]", pd->sym->name));
	    } else {
		pd->tp->basetype = mp->type;
		if (!mp->type->pointertype)
		    mp->type->pointertype = pd->tp;
	    }
        }
        ptrbase = ptrbase->next;
        FREE(pd);
    }
    declaretypes(outflag);
    outsection(minorspace);
    flushcomments(NULL, -1, -1);
    if (outflag)
        outsection(majorspace);
}





Static void nameexternalvar(mp, name)
Meaning *mp;
char *name;
{
    if (!wasaliased) {
	if (*externalias && my_strchr(externalias, '%'))
	    strchange(&mp->name, format_s(externalias, name));
	else
	    strchange(&mp->name, name);
    }
}


Static void handlebrackets(mp, skip, wasaliased)
Meaning *mp;
int skip, wasaliased;
{
    Expr *ex;

    checkkeyword(TOK_ORIGIN);
    if (curtok == TOK_ORIGIN) {
	gettok();
	ex = p_expr(tp_integer);
	mp->kind = MK_VARREF;
	mp->constdefn = gentle_cast(ex, tp_integer);
    } else if (curtok == TOK_LBR) {
        gettok();
        ex = p_expr(tp_integer);
        if (!wneedtok(TOK_RBR))
	    skippasttotoken(TOK_RBR, TOK_SEMI);
        if (skip) {
            freeexpr(ex);
            return;
        }
        if (ex->kind == EK_CONST && ex->val.type->kind == TK_STRING) {
	    nameexternalvar(mp, ex->val.s);
	    mp->isfunction = 1;   /* make it extern */
        } else {
            note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
            mp->kind = MK_VARREF;
            mp->constdefn = gentle_cast(ex, tp_integer);
        }
    }
}



Static void handleabsolute(mp, skip)
Meaning *mp;
int skip;
{
    Expr *ex;
    Value val;
    long i;

    checkkeyword(TOK_ABSOLUTE);
    if (curtok == TOK_ABSOLUTE) {
        gettok();
        if (skip) {
            freeexpr(p_expr(tp_integer));
            if (curtok == TOK_COLON) {
                gettok();
                freeexpr(p_expr(tp_integer));
            }
            return;
        }
        note(format_s("Absolute-addressed variable %s was generated [116]", mp->name));
        mp->kind = MK_VARREF;
        if (curtok == TOK_IDENT && 
            curtokmeaning && (curtokmeaning->kind != MK_CONST ||
                              ord_type(curtokmeaning->type)->kind != TK_INTEGER)) {
            mp->constdefn = makeexpr_addr(p_expr(NULL));
	    mp->isfunction = 1;   /* make it extern */
        } else {
            ex = gentle_cast(p_expr(tp_integer), tp_integer);
            if (curtok == TOK_COLON) {
                val = eval_expr(ex);
                if (!val.type)
                    warning("Expected a constant [127]");
                i = val.i & 0xffff;
                gettok();
                val = p_constant(tp_integer);
                i = (i<<16) | (val.i & 0xffff);   /* as good a notation as any! */
                ex = makeexpr_long(i);
                insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
            }
            mp->constdefn = ex;
        }
    }
}



void setupfilevar(mp)
Meaning *mp;
{
    if (mp->kind != MK_VARMAC && isfiletype(mp->type)) {
	if (storefilenames && *name_FNVAR)
	    mp->namedfile = 1;
	if (checkvarinlists(bufferedfiles, unbufferedfiles, 0, mp))
	    mp->bufferedfile = 1;
    }
}




void p_vardecl()
{
    Meaning *firstmp, *lastmp;
    Type *tp;
    int aliasflag, volatileflag, constflag, staticflag, globalflag, externflag;
    Strlist *l1;
    Expr *initexpr;

    gettok();
    notephase = 1;
    while (curtok == TOK_IDENT) {
        firstmp = lastmp = addmeaning(curtoksym, MK_VAR);
	lastmp->type = tp_integer;    /* in case of syntax errors */
        aliasflag = wasaliased;
        gettok();
        handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
	decl_comments(lastmp);
        while (curtok == TOK_COMMA) {
            gettok();
            if (wexpecttok(TOK_IDENT)) {
		lastmp = addmeaning(curtoksym, MK_VAR);
		lastmp->type = tp_integer;
		aliasflag = wasaliased;
		gettok();
		handlebrackets(lastmp, (lastmp->kind != MK_VAR), aliasflag);
		decl_comments(lastmp);
	    }
        }
        if (!wneedtok(TOK_COLON)) {
	    skippasttoken(TOK_SEMI);
	    continue;
	}
	p_attributes();
	volatileflag = constflag = staticflag = globalflag = externflag = 0;
	if ((l1 = strlist_find(attrlist, "READONLY")) != NULL) {
	    constflag = 1;
	    strlist_delete(&attrlist, l1);
	}
	if ((l1 = strlist_find(attrlist, "VOLATILE")) != NULL) {
	    volatileflag = 1;
	    strlist_delete(&attrlist, l1);
	}
	if ((l1 = strlist_find(attrlist, "STATIC")) != NULL) {
	    staticflag = 1;
	    strlist_delete(&attrlist, l1);
	}
	if ((l1 = strlist_find(attrlist, "AUTOMATIC")) != NULL) {
	    /* This is the default! */
	    strlist_delete(&attrlist, l1);
	}
	if ((l1 = strlist_find(attrlist, "AT")) != NULL) {
            note(format_s("Absolute-addressed variable %s was generated [116]", lastmp->name));
            lastmp->kind = MK_VARREF;
            lastmp->constdefn = makeexpr_long(l1->value);
	    strlist_delete(&attrlist, l1);
	}
	if ((l1 = strlist_find(attrlist, "GLOBAL")) != NULL ||
	    (l1 = strlist_find(attrlist, "WEAK_GLOBAL")) != NULL) {
	    globalflag = 1;
	    if (l1->value != -1)
		nameexternalvar(lastmp, (char *)l1->value);
	    if (l1->s[0] != 'W')
		strlist_delete(&attrlist, l1);
	}
	if ((l1 = strlist_find(attrlist, "EXTERNAL")) != NULL ||
	    (l1 = strlist_find(attrlist, "WEAK_EXTERNAL")) != NULL) {
	    externflag = 1;
	    if (l1->value != -1)
		nameexternalvar(lastmp, (char *)l1->value);
	    if (l1->s[0] != 'W')
		strlist_delete(&attrlist, l1);
	}
        tp = p_type(firstmp);
	decl_comments(lastmp);
        handleabsolute(lastmp, (lastmp->kind != MK_VAR));
	initexpr = NULL;
	if (curtok == TOK_ASSIGN) {    /* VAX Pascal initializer */
	    gettok();
	    initexpr = p_subconst(tp, 2);
	    if (lastmp->kind == MK_VARMAC) {
		freeexpr(initexpr);
		initexpr = NULL;
		note("Initializer ignored for variable with VarMacro [115]");
	    }
	}
        for (;;) {
            if (firstmp->kind == MK_VARREF) {
                firstmp->type = makepointertype(tp);
                firstmp->constdefn = makeexpr_cast(firstmp->constdefn, firstmp->type);
            } else {
                firstmp->type = tp;
		setupfilevar(firstmp);
		if (initexpr) {
		    if (firstmp == lastmp)
			firstmp->constdefn = initexpr;
		    else
			firstmp->constdefn = copyexpr(initexpr);
		}
            }
	    firstmp->volatilequal = volatileflag;
	    firstmp->constqual = constflag;
	    firstmp->isforward |= staticflag;
	    firstmp->isfunction |= externflag;
	    firstmp->exported |= globalflag;
	    if (globalflag && (curctx->kind != MK_MODULE || mainlocals))
		declarevar(firstmp, -1);
            if (firstmp == lastmp)
                break;
            firstmp = firstmp->cnext;
        }
        if (!wneedtok(TOK_SEMI))
	    skippasttoken(TOK_SEMI);
    }
    notephase = 0;
}




void p_valuedecl()
{
    Meaning *mp;

    gettok();
    while (curtok == TOK_IDENT) {
	if (!curtokmeaning ||
	    curtokmeaning->kind != MK_VAR) {
	    warning(format_s("Initializer ignored for variable %s [139]",
			     curtokmeaning->name));
	    skippasttoken(TOK_SEMI);
	} else {
	    mp = curtokmeaning;
	    gettok();
	    if (curtok == TOK_DOT || curtok == TOK_LBR) {
		note("Partial structure initialization not supported [117]");
		skippasttoken(TOK_SEMI);
	    } else if (wneedtok(TOK_ASSIGN)) {
		mp->constdefn = p_subconst(mp->type, 2);
		if (!wneedtok(TOK_SEMI))
		    skippasttoken(TOK_SEMI);
	    } else
		skippasttoken(TOK_SEMI);
	}
    }
}







/* Make a temporary variable that must be freed manually (or at the end of
   the current function by default) */

Meaning *maketempvar(type, name)
Type *type;
char *name;
{
    struct tempvarlist *tv, **tvp;
    Symbol *sym;
    Meaning *mp;
    char *fullname;

    tvp = &tempvars;   /* find a freed but allocated temporary */
    while ((tv = *tvp) && (!similartypes(tv->tvar->type, type) ||
                           tv->tvar->refcount == 0 ||
                           strcmp(tv->tvar->val.s, name)))
        tvp = &(tv->next);
    if (!tv) {
        tvp = &tempvars;    /* take over a now-cancelled temporary */
        while ((tv = *tvp) && (tv->tvar->refcount > 0 || 
                               strcmp(tv->tvar->val.s, name)))
            tvp = &(tv->next);
    }
    if (tv) {
        tv->tvar->type = type;
        *tvp = tv->next;
        mp = tv->tvar;
        FREE(tv);
        mp->refcount++;
        if (debug>1) { fprintf(outf,"maketempvar revives %s\n", mp->name); }
    } else {
        tempvarcount = 0;    /***/  /* experimental... */
        for (;;) {
            if (tempvarcount)
                fullname = format_s(name, format_d("%d", tempvarcount));
            else
                fullname = format_s(name, "");
            ++tempvarcount;
            sym = findsymbol(fullname);
            mp = sym->mbase;
            while (mp && !mp->isactive)
                mp = mp->snext;
            if (!mp)
                break;
            if (debug>1) { fprintf(outf,"maketempvar rejects %s\n", fullname); }
        }
	mp = addmeaning(sym, MK_VAR);
        mp->istemporary = 1;
        mp->type = type;
        mp->refcount = 1;
        mp->val.s = stralloc(name);
        if (debug>1) { fprintf(outf,"maketempvar creates %s\n", mp->name); }
    }
    return mp;
}



/* Make a temporary variable that will be freed at the end of this statement
   (rather than at the end of the function) by default */

Meaning *makestmttempvar(type, name)
Type *type;
char *name;
{
    struct tempvarlist *tv;
    Meaning *tvar;

    tvar = maketempvar(type, name);
    tv = ALLOC(1, struct tempvarlist, tempvars);
    tv->tvar = tvar;
    tv->active = 1;
    tv->next = stmttempvars;
    stmttempvars = tv;
    return tvar;
}



Meaning *markstmttemps()
{
    return (stmttempvars) ? stmttempvars->tvar : NULL;
}


void freestmttemps(mark)
Meaning *mark;
{
    struct tempvarlist *tv;

    while ((tv = stmttempvars) && tv->tvar != mark) {
        if (tv->active)
            freetempvar(tv->tvar);
        stmttempvars = tv->next;
        FREE(tv);
    }
}



/* This temporary variable is no longer used */

void freetempvar(tvar)
Meaning *tvar;
{
    struct tempvarlist *tv;

    if (debug>1) { fprintf(outf,"freetempvar frees %s\n", tvar->name); }
    tv = stmttempvars;
    while (tv && tv->tvar != tvar)
        tv = tv->next;
    if (tv)
        tv->active = 0;
    tv = ALLOC(1, struct tempvarlist, tempvars);
    tv->tvar = tvar;
    tv->next = tempvars;
    tempvars = tv;
}



/* The code that used this temporary variable has been deleted */

void canceltempvar(tvar)
Meaning *tvar;
{
    if (debug>1) { fprintf(outf,"canceltempvar cancels %s\n", tvar->name); }
    tvar->refcount--;
    freetempvar(tvar);
}








/* End. */