/* "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_DECL3_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 outbasetype(type, flags)
Type *type;
int flags;
{
    Meaning *mp;
    int saveindent;

    type = findbasetype(type, flags);
    switch (type->kind) {

        case TK_INTEGER:
            if (type == tp_uint) {
                output("unsigned");
            } else if (type == tp_sint) {
                if (useAnyptrMacros == 1)
                    output("Signed int");
                else if (hassignedchar)
                    output("signed int");
                else
                    output("int");   /* will sign-extend by hand */
            } else if (type == tp_unsigned) {
                output("unsigned long");
            } else if (type != tp_int)
                output(integername);
            else
                output("int");
            break;

        case TK_SUBR:
            if (type == tp_special_anyptr) {
                output("Anyptr");
            } else if (type == tp_abyte) {
                output("char");
            } else if (type == tp_ubyte) {
                output(ucharname);
            } else if (type == tp_sbyte) {
                output(scharname);
                if (signedchars != 1 && !hassignedchar)
                    note("'signed char' may not be valid in all compilers [102]");
            } else {
                if (type == tp_ushort)
                    output("unsigned ");
                output("short");
            }
            break;

        case TK_CHAR:
            if (type == tp_uchar) {
                output(ucharname);
            } else if (type == tp_schar) {
                output(scharname);
                if (signedchars != 1 && !hassignedchar)
                    note("'signed char' may not be valid in all compilers [102]");
	    } else
		output(charname);
            break;

        case TK_BOOLEAN:
            output((*name_BOOLEAN) ? name_BOOLEAN : ucharname);
            break;

        case TK_REAL:
	    if (type == tp_longreal)
		output("double");
	    else
		output("float");
            break;

        case TK_VOID:
            if (ansiC == 0)
                output("int");
            else if (useAnyptrMacros == 1)
                output("Void");
            else
                output("void");
            break;

        case TK_PROCPTR:
	    output(name_PROCEDURE);
	    break;

        case TK_FILE:
            output("FILE");
            break;

	case TK_SPECIAL:
	    if (type == tp_jmp_buf)
		output("jmp_buf");
	    break;

        default:
            if (type->meaning && type->meaning->kind == MK_TYPE &&
                type->meaning->wasdeclared) {
                output(type->meaning->name);
            } else {
                switch (type->kind) {

                    case TK_ENUM:
                        output("enum {\n");
			saveindent = outindent;
			moreindent(tabsize);
			moreindent(structindent);
                        mp = type->fbase;
                        while (mp) {
                            output(mp->name);
                            mp = mp->xnext;
                            if (mp)
				output(",\001 ");
                        }
                        outindent = saveindent;
                        output("\n}");
                        break;

                    case TK_RECORD:
                        if (record_is_union(type))
                            output("union ");
                        else
                            output("struct ");
                        if (type->meaning)
                            output(format_s(name_STRUCT, type->meaning->name));
			if (!type->structdefd) {
			    if (type->meaning) {
				type->structdefd = 1;
				output(" ");
			    }
                            output("{\n");
			    saveindent = outindent;
			    moreindent(tabsize);
			    moreindent(structindent);
                            outfieldlist(type->fbase);
                            outindent = saveindent;
                            output("}");
                        }
			break;

		    default:
			break;

                }
            }
            break;
    }
}



void out_type(type, witharrays)
Type *type;
int witharrays;
{
    if (!witharrays && type->kind == TK_ARRAY)
        type = makepointertype(type->basetype);
    outbasetype(type, 0);
    outdeclarator(type, "", 0);    /* write an "abstract declarator" */
}




int varstorageclass(mp)
Meaning *mp;
{
    int sclass;

    if (mp->kind == MK_PARAM || mp->kind == MK_VARPARAM ||
	mp->kind == MK_FIELD)
	sclass = 0;
    else if (blockkind == TOK_EXPORT)
        if (usevextern)
	    if (mp->constdefn &&
		(mp->kind == MK_VAR ||
		 mp->kind == MK_VARREF))
		sclass = 2;    /* extern */
	    else
		sclass = 1;    /* vextern */
        else
            sclass = 0;                         /* (plain) */
    else if (mp->isfunction && mp->kind != MK_FUNCTION)
	sclass = 2;   /* extern */
    else if (mp->ctx->kind == MK_MODULE &&
	     (var_static != 0 ||
	      (findsymbol(mp->name)->flags & NEEDSTATIC)) &&
	     !mp->exported && !mp->istemporary && blockkind != TOK_END)
        sclass = (useAnyptrMacros) ? 4 : 3;     /* (private) */
    else if (mp->isforward)
        sclass = 3;   /* static */
    else
	sclass = 0;   /* (plain) */
    if (mp->volatilequal)
	sclass |= 0x10;
    if (mp->constqual)
	sclass |= 0x20;
    if (debug>2) fprintf(outf, "varstorageclass(%s) = %d\n", mp->name, sclass);
    return sclass;
}


char *storageclassname(i)
int i;
{
    char *scname;

    switch (i & 0xf) {
        case 1:
            scname = "vextern ";
	    break;
        case 2:
            scname = "extern ";
	    break;
        case 3:
            scname = "static ";
	    break;
        case 4:
            scname = "Static ";
	    break;
        default:
            scname = "";
	    break;
    }
    if (i & 0x10)
	if (useAnyptrMacros == 1)
	    scname = format_s("%sVolatile ", scname);
	else if (ansiC > 0)
	    scname = format_s("%svolatile ", scname);
    if (i & 0x20)
	if (useAnyptrMacros == 1)
	    scname = format_s("%sConst ", scname);
	else if (ansiC > 0)
	    scname = format_s("%sconst ", scname);
    return scname;
}



void declarevar(mp, which)
Meaning *mp;
int which;    /* 0x1=header, 0x2=body, 0x4=trailer, 0x8=in varstruct */
{
    int isstatic, isstructconst, saveindent;

    isstructconst = checkstructconst(mp);
    isstatic = varstorageclass(mp);
    if (which & 0x8)
	isstatic &= 0x10;   /* clear all but Volatile flags */
    flushcomments(&mp->comments, CMT_PRE, -1);
    if (which & 0x1) {
        if (isstructconst)
            outsection(minorspace);
        output(storageclassname(isstatic));
        outbasetype(mp->type, 0);
        output(" \005");
    }
    if (which & 0x2) {
        outdeclarator(mp->type, mp->name, 0);
        if (mp->constdefn && blockkind != TOK_EXPORT &&
	    (mp->kind == MK_VAR || mp->kind == MK_VARREF)) {
            if (mp->varstructflag) {    /* move init code into function body */
                intwarning("declarevar",
                    format_s("Variable %s initializer not removed [125]", mp->name));
            } else {
                output(" = ");
                if (isstructconst) {
                    output("{\n");
		    saveindent = outindent;
		    moreindent(tabsize);
		    moreindent(structinitindent);
                    out_expr((Expr *)mp->constdefn->val.i);
                    outindent = saveindent;
                    output("\n}");
                } else
                    out_expr(mp->constdefn);
            }
        }
    }
    if (which & 0x4) {
        output(";");
	outtrailcomment(mp->comments, -1, declcommentindent);
	flushcomments(&mp->comments, -1, -1);
        if (isstructconst)
            outsection(minorspace);
    }
}




Static int checkvarmacdef(ex, mp)
Expr *ex;
Meaning *mp;
{
    int i;

    if ((ex->kind == EK_NAME || ex->kind == EK_BICALL) &&
	!strcmp(ex->val.s, mp->name)) {
	ex->kind = EK_VAR;
	ex->val.i = (long)mp;
	ex->val.type = mp->type;
	return 1;
    }
    if (ex->kind == EK_VAR && ex->val.i == (long)mp)
	return 1;
    i = ex->nargs;
    while (--i >= 0)
	if (checkvarmacdef(ex->args[i], mp))
	    return 1;
    return 0;
}


int checkvarmac(mp)
Meaning *mp;
{
    if (mp->kind != MK_VARMAC && mp->kind != MK_FUNCTION)
	return 0;
    if (!mp->constdefn)
	return 0;
    return checkvarmacdef(mp->constdefn, mp);
}



#define varkind(k) ((k)==MK_VAR||(k)==MK_VARREF||(k)==MK_PARAM||(k)==MK_VARPARAM)

int declarevars(ctx, invarstruct)
Meaning *ctx;
int invarstruct;
{
    Meaning *mp, *mp0, *mp2;
    Strlist *fnames, *fn;
    int flag, first;

    if (ctx->kind == MK_FUNCTION && ctx->varstructflag && !invarstruct) {
        output("struct ");
        output(format_s(name_LOC, ctx->name));
        output(" ");
        output(format_s(name_VARS, ctx->name));
        output(";\n");
        flag = 1;
    } else
        flag = 0;
    if (debug>2) {
        fprintf(outf,"declarevars:\n");
        for (mp = ctx->cbase; mp; mp = mp->xnext) {
            fprintf(outf, "  %-22s%-15s%3d", mp->name,
                                             meaningkindname(mp->kind),
                                             mp->refcount);
            if (mp->wasdeclared)
                fprintf(outf, " [decl]");
            if (mp->varstructflag)
                fprintf(outf, " [struct]");
            fprintf(outf, "\n");
        }
    }
    fnames = NULL;
    for (;;) {
        mp = ctx->cbase;
        while (mp && (!(varkind(mp->kind) || checkvarmac(mp)) ||
		      mp->wasdeclared || mp->varstructflag != invarstruct ||
		      mp->refcount <= 0))
            mp = mp->cnext;
        if (!mp)
            break;
        flag = 1;
        first = 1;
        mp0 = mp2 = mp;
        while (mp) {
            if ((varkind(mp->kind) || checkvarmac(mp)) &&
		!mp->wasdeclared &&
                varstorageclass(mp) == varstorageclass(mp0) &&
                mp->varstructflag == invarstruct && mp->refcount > 0) {
                if (mixable(mp2, mp, 0, 0) || first) {
                    if (!first)
                        output(",\001 ");
                    declarevar(mp, (first ? 0x3 : 0x2) |
			           (invarstruct ? 0x8 : 0));
		    mp2 = mp;
                    mp->wasdeclared = 1;
                    if (isfiletype(mp->type)) {
                        fn = strlist_append(&fnames, mp->name);
                        fn->value = (long)mp;
                    }
                    first = 0;
                } else
                    if (mixvars != 1)
                        break;
            }
	    if (first) {
		intwarning("declarevars",
			   format_s("Unable to declare %s [126]", mp->name));
		mp->wasdeclared = 1;
		first = 0;
	    }
            if (mixvars == 0)
                break;
            mp = mp->cnext;
        }
        declarevar(mp2, 0x4);
    }
    declarefiles(fnames);
    return flag;
}



void redeclarevars(ctx)
Meaning *ctx;
{
    Meaning *mp;

    for (mp = ctx->cbase; mp; mp = mp->cnext) {
        if ((mp->kind == MK_VAR || mp->kind == MK_VARREF) &&
            mp->constdefn) {
            mp->wasdeclared = 0;    /* mark for redeclaration, this time */
        }                           /*  with its initializer */
    }
}





void out_argdecls(ftype)
Type *ftype;
{
    Meaning *mp, *mp0;
    Type *tp;
    int done;
    int flag = 1;
    char *name;

    done = 0;
    do {
        mp = ftype->fbase;
        while (mp && mp->wasdeclared)
            mp = mp->xnext;
        if (mp) {
            if (flag)
                output("\n");
            flag = 0;
            mp0 = mp;
            outbasetype(mp->othername ? mp->rectype : mp->type,
			ODECL_CHARSTAR|ODECL_FREEARRAY);
            output(" \005");
            while (mp) {
                if (!mp->wasdeclared) {
                    if (mp == mp0 ||
			mixable(mp0, mp, 1, ODECL_CHARSTAR|ODECL_FREEARRAY)) {
                        if (mp != mp0)
                            output(",\001 ");
                        name = (mp->othername) ? mp->othername : mp->name;
                        tp = (mp->othername) ? mp->rectype : mp->type;
                        outdeclarator(tp, name,
				      ODECL_CHARSTAR|ODECL_FREEARRAY);
                        mp->wasdeclared = 1;
                    } else
                        if (mixvars != 1)
                            break;
                }
                mp = mp->xnext;
            }
            output(";\n");
        } else
            done = 1;
    } while (!done);
    for (mp0 = ftype->fbase; mp0 && (mp0->type != tp_strptr ||
                                     !mp0->anyvarflag); mp0 = mp0->xnext) ;
    if (mp0) {
        output("int ");
        for (mp = mp0; mp; mp = mp->xnext) {
            if (mp->type == tp_strptr && mp->anyvarflag) {
                if (mp != mp0) {
                    if (mixvars == 0)
                        output(";\nint ");
                    else
                        output(",\001 ");
                }
                output(format_s(name_STRMAX, mp->name));
            }
        }
        output(";\n");
    }
    if (ftype->meaning && ftype->meaning->ctx->kind == MK_FUNCTION &&
                          ftype->meaning->ctx->varstructflag) {
        if (flag)
            output("\n");
        output("struct ");
        output(format_s(name_LOC, ftype->meaning->ctx->name));
        output(" *");
        output(format_s(name_LINK, ftype->meaning->ctx->name));
        output(";\n");
    }
}




void makevarstruct(func)
Meaning *func;
{
    int flag = 0;
    int saveindent;

    outsection(minfuncspace);
    output(format_s("\n/* Local variables for %s: */\n", func->name));
    output("struct ");
    output(format_s(name_LOC, func->name));
    output(" {\n");
    saveindent = outindent;
    moreindent(tabsize);
    moreindent(structindent);
    if (func->ctx->kind == MK_FUNCTION && func->ctx->varstructflag) {
        output("struct ");
        output(format_s(name_LOC, func->ctx->name));
        output(" *");
        output(format_s(name_LINK, func->ctx->name));
        output(";\n");
        flag++;
    }
    flag += declarevars(func, 1);
    if (!flag)                       /* Avoid generating an empty struct */
        output("int _meef_;\n");     /* (I don't think this will ever happen) */
    outindent = saveindent;
    output("} ;\n");
    outsection(minfuncspace);
    strlist_insert(&varstructdecllist, func->name);
}






Type *maketype(kind)
enum typekind kind;
{
    Type *tp;
    tp = ALLOC(1, Type, types);
    tp->kind = kind;
    tp->basetype = NULL;
    tp->indextype = NULL;
    tp->pointertype = NULL;
    tp->meaning = NULL;
    tp->fbase = NULL;
    tp->smin = NULL;
    tp->smax = NULL;
    tp->issigned = 0;
    tp->dumped = 0;
    tp->structdefd = 0;
    return tp;
}




Type *makesubrangetype(type, smin, smax)
Type *type;
Expr *smin, *smax;
{
    Type *tp;

    if (type->kind == TK_SUBR)
        type = type->basetype;
    tp = maketype(TK_SUBR);
    tp->basetype = type;
    tp->smin = smin;
    tp->smax = smax;
    return tp;
}



Type *makesettype(setof)
Type *setof;
{
    Type *tp;
    long smax;

    if (ord_range(setof, NULL, &smax) && smax < setbits && smallsetconst >= 0)
        tp = maketype(TK_SMALLSET);
    else
        tp = maketype(TK_SET);
    tp->basetype = tp_integer;
    tp->indextype = setof;
    return tp;
}



Type *makestringtype(len)
int len;
{
    Type *type;
    int index;

    len |= 1;
    if (len >= stringceiling)
        type = tp_str255;
    else {
        index = (len-1) / 2;
        if (stringtypecache[index])
            return stringtypecache[index];
        type = maketype(TK_STRING);
        type->basetype = tp_char;
        type->indextype = makesubrangetype(tp_integer, 
                                           makeexpr_long(0), 
                                           makeexpr_long(len));
        stringtypecache[index] = type;
    }
    return type;
}



Type *makepointertype(type)
Type *type;
{
    Type *tp;

    if (type->pointertype)
        return type->pointertype;
    tp = maketype(TK_POINTER);
    tp->basetype = type;
    type->pointertype = tp;
    return tp;
}





Value p_constant(type)
Type *type;
{
    Value val;
    Expr *ex;

    ex = p_expr(type);
    if (type)
        ex = gentle_cast(ex, type);
    val = eval_expr(ex);
    freeexpr(ex);
    if (!val.type) {
        warning("Expected a constant [127]");
        val.type = (type) ? type : tp_integer;
    }
    return val;
}




int typebits(smin, smax)
long smin, smax;
{
    unsigned long size;
    int bits;

    if (smin >= 0 || (smin == -1 && smax == 0)) {
        bits = 1;
        size = smax;
    } else {
        bits = 2;
        smin = -1L - smin;
        if (smin >= smax)
            size = smin;
        else
            size = smax;
    }
    while (size > 1) {
        bits++;
        size >>= 1;
    }
    return bits;
}


int packedsize(fname, typep, sizep, mode)
char *fname;
Type **typep;
long *sizep;
int mode;
{
    Type *tp = *typep;
    long smin, smax;
    int res, issigned;
    short savefold;
    long size;

    if (packing == 0)   /* suppress packing */
        return 0;
    if (tp->kind != TK_SUBR && tp->kind != TK_INTEGER && tp->kind != TK_ENUM &&
        tp->kind != TK_CHAR && tp->kind != TK_BOOLEAN)
        return 0;
    if (tp == tp_unsigned)
	return 0;
    if (!ord_range(tp, &smin, &smax)) {
        savefold = foldconsts;
        foldconsts = 1;
        res = ord_range(tp, &smin, &smax);
        foldconsts = savefold;
        if (res) {
            note(format_s("Field width for %s is based on expansion of #defines [103]",
                          fname));
        } else {
            note(format_ss("Cannot compute size of field %s; assuming %s [104]",
                           fname, integername));
            return 0;
        }
    } else {
        if (tp->kind == TK_ENUM)
            note(format_ssd("Field width for %s assumes enum%s has %d elements [105]",
                            fname,
                            (tp->meaning) ? format_s(" %s", tp->meaning->name) : "",
                            smax + 1));
    }
    issigned = (smin < 0);
    size = typebits(smin, smax);
    if (size >= ((sizeof_long > 0) ? sizeof_long : 32))
        return 0;
    if (packing != 1) {
        if (size <= 8)
            size = 8;
        else if (size <= 16)
            size = 16;
        else
            return 0;
    }
    if (!issigned) {
        *typep = (mode == 0) ? tp_int : tp_uint;
    } else {
        if (mode == 2 && !hassignedchar && !*signextname)
            return 0;
        *typep = (mode == 1) ? tp_int : tp_sint;
    }
    *sizep = size;
    return issigned;
}



Static void fielddecl(mp, type, tp2, val, ispacked, aligned)
Meaning *mp;
Type **type, **tp2;
long *val;
int ispacked, *aligned;
{
    long smin, smax, smin2, smax2;

    *tp2 = *type;
    *val = 0;
    if (ispacked && !mp->constdefn && *type != tp_unsigned) {
        (void)packedsize(mp->sym->name, tp2, val, signedfield);
        if (*aligned && *val &&
            (ord_type(*type)->kind == TK_CHAR ||
             ord_type(*type)->kind == TK_INTEGER) &&
            ord_range(findbasetype(*type, 0), &smin, &smax)) {
	    if (ord_range(*type, &smin2, &smax2)) {
		if (typebits(smin, smax) == 16 &&
		    typebits(smin2, smax2) == 8 && *val == 8) {
		    *tp2 = tp_abyte;
		}
	    }
	    if (typebits(smin, smax) == *val &&
		*val != 7) {    /* don't be fooled by tp_abyte */
		/* don't need to use a bit-field for this field */
		/* so not specifying one may make it more efficient */
		/* (and also helps to simulate HP's $allow_packed$ mode) */
		*val = 0;
		*tp2 = *type;
	    } 
        }
        if (*aligned && *val == 8 &&
            (ord_type(*type)->kind == TK_BOOLEAN ||
             ord_type(*type)->kind == TK_ENUM)) {
            *val = 0;
            *tp2 = tp_ubyte;
        }
    }
    if (*val != 8 && *val != 16)
	*aligned = (*val == 0);
}



/* This function locates byte-sized fields which were unaligned, but which
   are followed by aligned quantities so that they can be made aligned
   with no loss in storage efficiency. */

Static void realignfields(firstmp, stopmp)
Meaning *firstmp, *stopmp;
{
    Meaning *mp;

    for (mp = firstmp; mp && mp != stopmp; mp = mp->cnext) {
	if (mp->kind == MK_FIELD) {
	    if (mp->val.i == 16) {
		if (mp->type == tp_uint)
		    mp->type = tp_ushort;
		else
		    mp->type = tp_sshort;
		mp->val.i = 0;
	    } else if (mp->val.i == 8) {
		if (mp->type == tp_uint) {
		    mp->type = tp_ubyte;
		    mp->val.i = 0;
		} else if (hassignedchar || signedchars == 1) {
		    mp->type = tp_sbyte;
		    mp->val.i = 0;
		} else
		    mp->type = tp_abyte;
	    }
	}
    }
}

static void tryrealignfields(firstmp)
Meaning *firstmp;
{
    Meaning *mp, *head;

    head = NULL;
    for (mp = firstmp; mp; mp = mp->cnext) {
	if (mp->kind == MK_FIELD) {
	    if (mp->val.i == 8 || mp->val.i == 16) {
		if (!head)
		    head = mp;
	    } else {
		if (mp->val.i == 0)
		    realignfields(head, mp);
		head = NULL;
	    }
	}
    }
    realignfields(head, NULL);
}



void decl_comments(mp)
Meaning *mp;
{
    Strlist *cmt;

    if (spitcomments != 1) {
	changecomments(curcomments, -1, -1, CMT_PRE, 0);
	strlist_mix(&mp->comments, curcomments);
	curcomments = NULL;
	cmt = grabcomment(CMT_TRAIL);
	if (cmt) {
	    changecomments(mp->comments, CMT_TRAIL, -1, CMT_PRE, -1);
	    strlist_mix(&mp->comments, cmt);
	}
	if (mp->comments)
	    mp->refcount++;   /* force it to be included if it has comments */
    }
}





Static void p_fieldlist(tp, flast, ispacked, tname)
Type *tp;
Meaning **flast;
int ispacked;
Meaning *tname;
{
    Meaning *firstm, *lastm, *veryfirstm;
    Symbol *sym;
    Type *type, *tp2;
    long li1, li2;
    int aligned, constflag, volatileflag;
    short saveskipind;
    Strlist *l1;

    saveskipind = skipindices;
    skipindices = 0;
    aligned = 1;
    lastm = NULL;
    veryfirstm = NULL;
    while (curtok == TOK_IDENT) {
        firstm = addfield(curtoksym, &flast, tp, tname);
	if (!veryfirstm)
	    veryfirstm = firstm;
        lastm = firstm;
        gettok();
	decl_comments(lastm);
        while (curtok == TOK_COMMA) {
            gettok();
            if (wexpecttok(TOK_IDENT))
		lastm = addfield(curtoksym, &flast, tp, tname);
            gettok();
	    decl_comments(lastm);
        }
        if (wneedtok(TOK_COLON)) {
	    constflag = volatileflag = 0;
	    p_attributes();
	    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);
	    }
	    type = p_type(firstm);
	    decl_comments(lastm);
	    fielddecl(firstm, &type, &tp2, &li1, ispacked, &aligned);
	    for (;;) {
		firstm->type = tp2;
		firstm->val.type = type;
		firstm->val.i = li1;
		firstm->constqual = constflag;
		firstm->volatilequal = volatileflag;
		tp->meaning = tname;
		setupfilevar(firstm);
		tp->meaning = NULL;
		if (firstm == lastm)
		    break;
		firstm = firstm->cnext;
	    }
	} else
	    skiptotoken2(TOK_SEMI, TOK_CASE);
        if (curtok == TOK_SEMI)
            gettok();
    }
    if (curtok == TOK_CASE) {
        gettok();
	if (curtok == TOK_COLON)
	    gettok();
	wexpecttok(TOK_IDENT);
	sym = curtoksym;
	if (curtokmeaning)
	    type = curtokmeaning->type;
	gettok();
        if (curtok == TOK_COLON) {
            firstm = addfield(sym, &flast, tp, tname);
	    if (!veryfirstm)
		veryfirstm = firstm;
            gettok();
	    firstm->isforward = 1;
            firstm->val.type = type = p_type(firstm);
            fielddecl(firstm, &firstm->val.type, &firstm->type, &firstm->val.i, 
                      ispacked, &aligned);
        } else {
	    firstm = NULL;
	}
        if (!wneedtok(TOK_OF)) {
	    skiptotoken2(TOK_END, TOK_RPAR);
	    goto bounce;
	}
	if (firstm)
	    decl_comments(firstm);
	while (curtok == TOK_VBAR)
	    gettok();
        while (curtok != TOK_END && curtok != TOK_RPAR) {
            firstm = NULL;
            for (;;) {
		lastm = addfield(NULL, &flast, tp, tname);
		if (!firstm)
		    firstm = lastm;
		checkkeyword(TOK_OTHERWISE);
		if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
		    lastm->val = make_ord(type, 999);
		    break;
		} else {
		    lastm->val = p_constant(type);
		    if (curtok == TOK_DOTS) {
			gettok();
			li1 = ord_value(lastm->val);
			li2 = ord_value(p_constant(type));
			while (++li1 <= li2) {
			    lastm = addfield(NULL, &flast, tp, tname);
			    lastm->val = make_ord(type, li1);
			}
		    }
		}
                if (curtok == TOK_COMMA)
                    gettok();
                else
                    break;
            }
	    if (curtok == TOK_ELSE || curtok == TOK_OTHERWISE) {
		gettok();
            } else if (!wneedtok(TOK_COLON) ||
		     (!modula2 && !wneedtok(TOK_LPAR))) {
		skiptotoken2(TOK_END, TOK_RPAR);
		goto bounce;
	    }
            p_fieldlist(tp, &lastm->ctx, ispacked, tname);
            while (firstm != lastm) {
                firstm->ctx = lastm->ctx;
                firstm = firstm->cnext;
            }
	    if (modula2) {
		while (curtok == TOK_VBAR)
		    gettok();
	    } else {
		if (!wneedtok(TOK_RPAR))
		    skiptotoken(TOK_RPAR);
	    }
            if (curtok == TOK_SEMI)
                gettok();
        }
	if (modula2) {
	    wneedtok(TOK_END);
	    if (curtok == TOK_IDENT) {
		note("Record variants supported only at end of record [106]");
		p_fieldlist(tp, &lastm->ctx, ispacked, tname);
	    }
	}
    }
    tryrealignfields(veryfirstm);
    if (lastm && curtok == TOK_END) {
	strlist_mix(&lastm->comments, curcomments);
	curcomments = NULL;
    }

  bounce:
    skipindices = saveskipind;
}