/* "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_DECL2_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;

Meaning *addmeaningas(sym, kind, namekind)
Symbol *sym;
enum meaningkind kind, namekind;
{
    Meaning *mp;

    mp = ALLOC(1, Meaning, meanings);
    initmeaning(mp);
    setupmeaning(mp, sym, kind, namekind);
    mp->cnext = NULL;
    if (curctx) {
        if (curctxlast)
            curctxlast->cnext = mp;
        else
            curctx->cbase = mp;
        curctxlast = mp;
    }
    return mp;
}



Meaning *addmeaning(sym, kind)
Symbol *sym;
enum meaningkind kind;
{
    return addmeaningas(sym, kind, kind);
}



Meaning *addmeaningafter(mpprev, sym, kind)
Meaning *mpprev;
Symbol *sym;
enum meaningkind kind;
{
    Meaning *mp;

    if (!mpprev->cnext && mpprev->ctx == curctx)
        return addmeaning(sym, kind);
    mp = ALLOC(1, Meaning, meanings);
    initmeaning(mp);
    setupmeaning(mp, sym, kind, kind);
    mp->ctx = mpprev->ctx;
    mp->cnext = mpprev->cnext;
    mpprev->cnext = mp;
    return mp;
}


void unaddmeaning(mp)
Meaning *mp;
{
    Meaning *prev;

    prev = mp->ctx;
    while (prev && prev != mp)
	prev = prev->cnext;
    if (prev)
	prev->cnext = mp->cnext;
    else
	mp->ctx = mp->cnext;
    if (!mp->cnext && mp->ctx == curctx)
	curctxlast = prev;
}


void readdmeaning(mp)
Meaning *mp;
{
    mp->cnext = NULL;
    if (curctx) {
        if (curctxlast)
            curctxlast->cnext = mp;
        else
            curctx->cbase = mp;
        curctxlast = mp;
    }
}


Meaning *addfield(sym, flast, rectype, tname)
Symbol *sym;
Meaning ***flast;
Type *rectype;
Meaning *tname;
{
    Meaning *mp;
    int altnum;
    Symbol *sym2;
    Strlist *sl;
    char *name, *name2;

    mp = ALLOC(1, Meaning, meanings);
    initmeaning(mp);
    mp->sym = sym;
    if (sym) {
        mp->snext = sym->fbase;
        sym->fbase = mp;
        if (sym == curtoksym)
            name2 = curtokcase;
        else
            name2 = sym->name;
	name = name2;
        if (tname)
            sl = strlist_find(fieldmacros,
                              format_ss("%s.%s", tname->sym->name, sym->name));
        else
            sl = NULL;
        if (sl) {
            mp->constdefn = (Expr *)sl->value;
            strlist_delete(&fieldmacros, sl);
            altnum = 0;
        } else {
            altnum = -1;
            do {
                altnum++;
		if (*fieldformat)
		    name = format_ss(fieldformat, name2,
				     tname && tname->name ? tname->name
				                          : "FIELD");
                sym2 = findsymbol(findaltname(name, altnum));
            } while (!issafename(sym2, 0, 0) ||
		     ((sym2->flags & AVOIDFIELD) && !reusefieldnames));
	    if (!reusefieldnames)
		sym2->flags |= AVOIDFIELD;
        }
        mp->kind = MK_FIELD;
        mp->name = stralloc(findaltname(name, altnum));
    } else {
        mp->name = stralloc("(variant)");
        mp->kind = MK_VARIANT;
    }
    mp->cnext = NULL;
    **flast = mp;
    *flast = &(mp->cnext);
    mp->ctx = NULL;
    mp->rectype = rectype;
    mp->val.i = 0;
    return mp;
}





int isfiletype(type)
Type *type;
{
    return (type->kind == TK_POINTER &&
            type->basetype->kind == TK_FILE);
}


Meaning *isfilevar(ex)
Expr *ex;
{
    Meaning *mp;

    if (ex->kind == EK_VAR) {
	mp = (Meaning *)ex->val.i;
	if (mp->kind == MK_VAR)
	    return mp;
    } else if (ex->kind == EK_DOT) {
	mp = (Meaning *)ex->val.i;
	if (mp && mp->kind == MK_FIELD)
	    return mp;
    }
    return NULL;
}



Type *findbasetype_(type, flags)
Type *type;
int flags;
{
    long smin, smax;

    for (;;) {
        switch (type->kind) {

            case TK_POINTER:
                if (type->basetype == tp_void) {     /* ANYPTR */
                    if (tp_special_anyptr)
                        return tp_special_anyptr;   /* write "Anyptr" */
                    if (!voidstar)
                        return tp_abyte;    /* write "char *", not "void *" */
                }
                switch (type->basetype->kind) {

                    case TK_ARRAY:       /* use basetype's basetype: */
                    case TK_STRING:      /* ^array[5] of array[3] of integer */
                    case TK_SET:         /*  => int (*a)[3]; */
		        if (stararrays == 1 ||
			    !(flags & ODECL_FREEARRAY) ||
			    type->basetype->structdefd) {
			    type = type->basetype;
			    flags &= ~ODECL_CHARSTAR;
			}
                        break;

		    default:
			break;
                }
                break;

            case TK_FUNCTION:
            case TK_STRING:
            case TK_SET:
            case TK_SMALLSET:
            case TK_SMALLARRAY:
                if (!type->basetype)
                    return type;
                break;

            case TK_ARRAY:
                if (type->meaning && type->meaning->kind == MK_TYPE &&
                    type->meaning->wasdeclared)
                    return type;
                break;

            case TK_FILE:
                return tp_text->basetype;

            case TK_PROCPTR:
		return tp_proc;

	    case TK_CPROCPTR:
		type = type->basetype->basetype;
		continue;

            case TK_ENUM:
                if (useenum)
                    return type;
                else if (!enumbyte ||
			 type->smax->kind != EK_CONST ||
			 type->smax->val.i > 255)
		    return tp_sshort;
		else if (type->smax->val.i > 127)
                    return tp_ubyte;
		else
                    return tp_abyte;

            case TK_BOOLEAN:
                if (*name_BOOLEAN)
                    return type;
                else
                    return tp_ubyte;

            case TK_SUBR:
                if (type == tp_abyte || type == tp_ubyte || type == tp_sbyte ||
                    type == tp_ushort || type == tp_sshort) {
                    return type;
                } else if ((type->basetype->kind == TK_ENUM && useenum) ||
                           type->basetype->kind == TK_BOOLEAN && *name_BOOLEAN) {
                    return type->basetype;
                } else {
                    if (ord_range(type, &smin, &smax)) {
                        if (squeezesubr != 0) {
                            if (smin >= 0 && smax <= max_schar)
                                return tp_abyte;
                            else if (smin >= 0 && smax <= max_uchar)
                                return tp_ubyte;
                            else if (smin >= min_schar && smax <= max_schar &&
				     (signedchars == 1 || hassignedchar))
                                return tp_sbyte;
                            else if (smin >= min_sshort && smax <= max_sshort)
                                return tp_sshort;
                            else if (smin >= 0 && smax <= max_ushort)
                                return tp_ushort;
                            else
                                return tp_integer;
                        } else {
                            if (smin >= min_sshort && smax <= max_sshort)
                                return tp_sshort;
                            else
                                return tp_integer;
                        }
                    } else
                        return tp_integer;
                }

	    case TK_CHAR:
		if (type == tp_schar &&
		    (signedchars != 1 && !hassignedchar)) {
		    return tp_sshort;
		}
		return type;

            default:
                return type;
        }
        type = type->basetype;
    }
}


Type *findbasetype(type, flags)
Type *type;
int flags;
{
    if (debug>1) {
	fprintf(outf, "findbasetype(");
	dumptypename(type, 1);
	fprintf(outf, ",%d) = ", flags);
	type = findbasetype_(type, flags);
	dumptypename(type, 1);
	fprintf(outf, "\n");
	return type;
    }
    return findbasetype_(type, flags);
}



Expr *arraysize(tp, incskipped)
Type *tp;
int incskipped;
{
    Expr *ex, *minv, *maxv;
    int denom;

    ord_range_expr(tp->indextype, &minv, &maxv);
    if (maxv->kind == EK_VAR && maxv->val.i == (long)mp_maxint &&
	!exprdependsvar(minv, mp_maxint)) {
        return NULL;
    } else {
        ex = makeexpr_plus(makeexpr_minus(copyexpr(maxv),
                                          copyexpr(minv)),
                           makeexpr_long(1));
        if (tp->smin && !incskipped) {
            ex = makeexpr_minus(ex, copyexpr(tp->smin));
        }
        if (tp->smax) {
            denom = (tp->basetype == tp_sshort) ? 16 : 8;
            denom >>= tp->escale;
            ex = makeexpr_div(makeexpr_plus(ex, makeexpr_long(denom-1)),
                              makeexpr_long(denom));
        }
        return ex;
    }
}



Type *promote_type(tp)
Type *tp;
{
    Type *tp2;

    if (tp->kind == TK_ENUM) {
	if (promote_enums == 0 ||
	    (promote_enums < 0 &&
	     (useenum)))
	    return tp;
    }
    if (tp->kind == TK_ENUM ||
         tp->kind == TK_SUBR ||
         tp->kind == TK_INTEGER ||
         tp->kind == TK_CHAR ||
         tp->kind == TK_BOOLEAN) {
        tp2 = findbasetype(tp, 0);
	if (tp2 == tp_ushort && sizeof_int == 16)
	    return tp_uint;
        else if (tp2 == tp_sbyte || tp2 == tp_ubyte ||
		 tp2 == tp_abyte || tp2 == tp_char ||
		 tp2 == tp_sshort || tp2 == tp_ushort ||
		 tp2 == tp_boolean || tp2->kind == TK_ENUM) {
            return tp_int;
        }
    }
    if (tp == tp_real)
	return tp_longreal;
    return tp;
}


Type *promote_type_bin(t1, t2)
Type *t1, *t2;
{
    t1 = promote_type(t1);
    t2 = promote_type(t2);
    if (t1 == tp_longreal || t2 == tp_longreal)
	return tp_longreal;
    if (t1 == tp_unsigned || t2 == tp_unsigned)
	return tp_unsigned;
    if (t1 == tp_integer || t2 == tp_integer) {
	if ((t1 == tp_uint || t2 == tp_uint) &&
	    sizeof_int > 0 &&
	    sizeof_int < (sizeof_long > 0 ? sizeof_long : 32))
	    return tp_uint;
	return tp_integer;
    }
    if (t1 == tp_uint || t2 == tp_uint)
	return tp_uint;
    return t1;
}



#if 0
void predeclare_varstruct(mp)
Meaning *mp;
{
    if (mp->ctx &&
	 mp->ctx->kind == MK_FUNCTION &&
	 mp->ctx->varstructflag &&
	 (usePPMacros != 0 || prototypes != 0) &&
	 !strlist_find(varstructdecllist, mp->ctx->name)) {
	output("struct ");
	output(format_s(name_LOC, mp->ctx->name));
	output(" ;\n");
	strlist_insert(&varstructdecllist, mp->ctx->name);
    }
}
#endif


Static void declare_args(type, isheader, isforward)
Type *type;
int isheader, isforward;
{
    Meaning *mp = type->fbase;
    Type *tp;
    int firstflag = 0;
    int usePP, dopromote, proto, showtypes, shownames;
    int staticlink;
    char *name;

#if 1   /* This seems to work better! */
    isforward = !isheader;
#endif
    usePP = (isforward && usePPMacros != 0);
    dopromote = (promoteargs == 1 ||
		 (promoteargs < 0 && (usePP || !fullprototyping)));
    if (ansiC == 1 && blockkind != TOK_EXPORT)
	usePP = 0;
    if (usePP)
        proto = (prototypes) ? prototypes : 1;
    else
        proto = (isforward || fullprototyping) ? prototypes : 0;
    showtypes = (proto > 0);
    shownames = (proto == 1 || isheader);
    staticlink = (type->issigned ||
                  (type->meaning &&
                   type->meaning->ctx->kind == MK_FUNCTION &&
                   type->meaning->ctx->varstructflag));
    if (mp || staticlink) {
        if (usePP)
            output(" PP(");
        output("(");
        if (showtypes || shownames) {
            firstflag = 0;
            while (mp) {
                if (firstflag++) output(",\002 ");
                name = (mp->othername && isheader) ? mp->othername : mp->name;
                tp = (mp->othername) ? mp->rectype : mp->type;
                if (!showtypes) {
                    output(name);
                } else {
		    output(storageclassname(varstorageclass(mp)));
		    if (!shownames || (isforward && *name == '_')) {
			out_type(tp, 1);
		    } else {
			if (dopromote)
			    tp = promote_type(tp);
			outbasetype(tp, ODECL_CHARSTAR|ODECL_FREEARRAY);
			output(" ");
			outdeclarator(tp, name,
				      ODECL_CHARSTAR|ODECL_FREEARRAY);
		    }
		}
                if (isheader)
                    mp->wasdeclared = showtypes;
                if (mp->type == tp_strptr && mp->anyvarflag) {     /* VAR STRING parameter */
                    output(",\002 ");
                    if (showtypes) {
			if (useAnyptrMacros == 1 || useconsts == 2)
			    output("Const ");
			else if (ansiC > 0)
			    output("const ");
                        output("int");
		    }
                    if (shownames) {
                        if (showtypes)
                            output(" ");
                        output(format_s(name_STRMAX, mp->name));
                    }
                }
                mp = mp->xnext;
            }
            if (staticlink) {     /* sub-procedure with static link */
                if (firstflag++) output(",\002 ");
                if (type->issigned) {
                    if (showtypes)
			if (tp_special_anyptr)
			    output("Anyptr ");
			else if (voidstar)
			    output("void *");
			else
			    output("char *");
                    if (shownames)
                        output("_link");
                } else {
                    mp = type->meaning->ctx;
                    if (showtypes) {
                        output("struct ");
                        output(format_s(name_LOC, mp->name));
                        output(" *");
                    }
                    if (shownames) {
                        output(format_s(name_LINK, mp->name));
                    }
                }
            }
        }
        output(")");
        if (usePP)
            output(")");
    } else {
        if (usePP)
            output(" PV()");
        else if (void_args)
            output("(void)");
        else
            output("()");
    }
}



void outdeclarator(type, name, flags)
Type *type;
char *name;
int flags;
{
    int i, depth, anyptrs, anyarrays;
    Expr *dimen[30];
    Expr *ex, *maxv;
    Type *tp, *functype;
    Expr funcdummy;   /* yow */

    anyptrs = 0;
    anyarrays = 0;
    functype = NULL;
    for (depth = 0, tp = type; tp; tp = tp->basetype) {
        switch (tp->kind) {

            case TK_POINTER:
                if (tp->basetype) {
                    switch (tp->basetype->kind) {

		        case TK_VOID:
			    if (tp->basetype == tp_void &&
				tp_special_anyptr) {
				tp = tp_special_anyptr;
				continue;
			    }
			    break;

                        case TK_ARRAY:    /* ptr to array of x => ptr to x */
                        case TK_STRING:   /*                or => array of x */
                        case TK_SET:
			    if (stararrays == 1 ||
				!(flags & ODECL_FREEARRAY) ||
				(tp->basetype->structdefd &&
				 stararrays != 2)) {
				tp = tp->basetype;
				flags &= ~ODECL_CHARSTAR;
			    } else {
				continue;
			    }
                            break;

			default:
			    break;
                    }
                }
                dimen[depth++] = NULL;
                anyptrs++;
                continue;

            case TK_ARRAY:
		flags &= ~ODECL_CHARSTAR;
                if (tp->meaning && tp->meaning->kind == MK_TYPE &&
                    tp->meaning->wasdeclared)
                    break;
		if (tp->structdefd) {    /* conformant array */
		    if (!variablearrays &&
			!(tp->basetype->kind == TK_ARRAY &&
			  tp->basetype->structdefd))   /* avoid mult. notes */
			note("Conformant array code may not work in all compilers [101]");
		}
                ex = arraysize(tp, 1);
                if (!ex)
                    ex = makeexpr_name("", tp_integer);
                dimen[depth++] = ex;
		anyarrays++;
                continue;

            case TK_SET:
                ord_range_expr(tp->indextype, NULL, &maxv);
                maxv = enum_to_int(copyexpr(maxv));
                if (ord_type(maxv->val.type)->kind == TK_CHAR)
                    maxv->val.type = tp_integer;
                dimen[depth++] = makeexpr_plus(makeexpr_div(maxv, makeexpr_setbits()),
                                               makeexpr_long(2));
                break;

            case TK_STRING:
                if ((flags & ODECL_CHARSTAR) && stararrays == 1) {
                    dimen[depth++] = NULL;
                } else {
                    ord_range_expr(tp->indextype, NULL, &maxv);
                    dimen[depth++] = makeexpr_plus(copyexpr(maxv), makeexpr_long(1));
                }
                continue;

            case TK_FILE:
                break;

	    case TK_CPROCPTR:
		dimen[depth++] = NULL;
		anyptrs++;
		if (procptrprototypes)
		    continue;
                dimen[depth++] = &funcdummy;
		break;

            case TK_FUNCTION:
                dimen[depth++] = &funcdummy;
                if (!functype)
                    functype = tp;
                continue;

	    default:
		break;
        }
        break;
    }
    if (!*name && depth && (spaceexprs > 0 ||
                            (spaceexprs != 0 && !dimen[depth-1])))
        output(" ");    /* spacing for abstract declarator */
    if ((flags & ODECL_FUNCTION) && anyptrs)
        output(" ");
    if (anyarrays > 1 && !(flags & ODECL_FUNCTION))
	output("\003");
    for (i = depth; --i >= 0; ) {
        if (!dimen[i])
            output("*");
        if (i > 0 &&
            ((dimen[i] && !dimen[i-1]) ||
             (dimen[i-1] && !dimen[i] && extraparens > 0)))
            output("(");
    }
    if (flags & ODECL_FUNCTION)
        output("\n");
    if (anyarrays > 1 && (flags & ODECL_FUNCTION))
	output("\003");
    output(name);
    for (i = 0; i < depth; i++) {
        if (i > 0 &&
            ((dimen[i] && !dimen[i-1]) ||
             (dimen[i-1] && !dimen[i] && extraparens > 0)))
            output(")");
        if (dimen[i]) {
            if (dimen[i] == &funcdummy) {
		if (lookback(1) == ')')
		    output("\002");
		if (functype)
		    declare_args(functype, (flags & ODECL_HEADER) != 0,
				           (flags & ODECL_FORWARD) != 0);
		else
		    output("()");
            } else {
		if (lookback(1) == ']')
		    output("\002");
                output("[");
                if (!(flags & ODECL_FREEARRAY) || stararrays == 0 || i > 0)
                    out_expr(dimen[i]);
                freeexpr(dimen[i]);
                output("]");
            }
        }
    }
    if (anyarrays > 1)
	output("\004");
}






/* Find out if types t1 and t2 will work out to be the same C type,
   for purposes of type-casting */

Type *canonicaltype(type)
Type *type;
{
    if (type->kind == TK_SUBR || type->kind == TK_ENUM ||
        type->kind == TK_PROCPTR)
        type = findbasetype(type, 0);
    if (type == tp_char)
        return tp_ubyte;
    if (type->kind == TK_POINTER) {
        if (type->basetype->kind == TK_ARRAY ||
            type->basetype->kind == TK_STRING ||
            type->basetype->kind == TK_SET)
            return makepointertype(canonicaltype(type->basetype->basetype));
        else if (type->basetype == tp_void)
            return (voidstar) ? tp_anyptr : makepointertype(tp_abyte);
        else if (type->basetype->kind == TK_FILE)
            return tp_text;
        else
            return makepointertype(canonicaltype(type->basetype));
    }
    return type;
}


int similartypes(t1, t2)
Type *t1, *t2;
{
    t1 = canonicaltype(t1);
    t2 = canonicaltype(t2);
    return (t1 == t2);
}





Static int checkstructconst(mp)
Meaning *mp;
{
    return (mp->kind == MK_VAR &&
	    mp->constdefn &&
            mp->constdefn->kind == EK_CONST &&
            (mp->constdefn->val.type->kind == TK_ARRAY ||
             mp->constdefn->val.type->kind == TK_RECORD));
}


Static int mixable(mp1, mp2, args, flags)
Meaning *mp1, *mp2;
int args, flags;
{
    Type *tp1 = mp1->type, *tp2 = mp2->type;

    if (mixvars == 0)
        return 0;
    if (mp1->kind == MK_FIELD &&
        (mp1->val.i || mp2->val.i) && mixfields == 0)
        return 0;
    if (checkstructconst(mp1) || checkstructconst(mp2))
        return 0;
    if (mp1->comments) {
	if (findcomment(mp1->comments, CMT_NOT | CMT_PRE, -1))
	    return 0;
    }
    if (mp2->comments) {
	if (findcomment(mp2->comments, CMT_PRE, -1))
	    return 0;
    }
    if ((mp1->constdefn && (mp1->kind == MK_VAR || mp1->kind == MK_VARREF)) ||
	(mp2->constdefn && (mp2->kind == MK_VAR || mp2->kind == MK_VARREF))) {
        if (mixinits == 0)
            return 0;
        if (mixinits != 1 &&
            (!mp1->constdefn || !mp2->constdefn))
            return 0;
    }
    if (args) {
        if (mp1->kind == MK_PARAM && mp1->othername)
            tp1 = mp1->rectype;
        if (mp2->kind == MK_PARAM && mp2->othername)
            tp2 = mp2->rectype;
    }
    if (tp1 == tp2)
        return 1;
    switch (mixtypes) {
        case 0:
            return 0;
        case 1:
            return (findbasetype(tp1, flags) == findbasetype(tp2, flags));
        default:
            if (findbasetype(tp1, flags) != findbasetype(tp2, flags))
		return 0;
            while (tp1->kind == TK_POINTER && tp1->basetype)
                tp1 = tp1->basetype;
            while (tp2->kind == TK_POINTER && tp2->basetype)
                tp2 = tp2->basetype;
            return (tp1 == tp2);
    }
}



void declarefiles(fnames)
Strlist *fnames;
{
    Meaning *mp;
    char *cp;

    while (fnames) {
	mp = (Meaning *)fnames->value;
	if (mp->kind == MK_VAR || mp->kind == MK_FIELD) {
	    if (mp->namedfile) {
		output(storageclassname(varstorageclass(mp)));
		output(format_ss("%s %s", charname,
				 format_s(name_FNVAR, fnames->s)));
		output(format_s("[%s];\n", *name_FNSIZE ? name_FNSIZE : "80"));
	    }
	    if (mp->bufferedfile && *declbufname) {
		cp = format_s("%s", storageclassname(varstorageclass(mp)));
		if (*cp && isspace(cp[strlen(cp)-1]))
		  cp[strlen(cp)-1] = 0;
		if (*cp || !*declbufncname) {
		    output(declbufname);
		    output("(");
		    output(fnames->s);
		    output(",");
		    output(cp);
		} else {
		    output(declbufncname);
		    output("(");
		    output(fnames->s);
		}
		output(",");
		out_type(mp->type->basetype->basetype, 1);
		output(");\n");
	    }
	}
	strlist_eat(&fnames);
    }
}



char *variantfieldname(num)
int num;
{
    if (num >= 0)
        return format_d("U%d", num);
    else
        return format_d("UM%d", -num);
}


int record_is_union(tp)
Type *tp;
{
    return (tp->fbase && tp->fbase->kind == MK_VARIANT);
}


void outfieldlist(mp)
Meaning *mp;
{
    Meaning *mp0;
    int num, only_union, empty, saveindent, saveindent2;
    Strlist *fnames, *fn;

    if (!mp) {
	output("int empty_struct;   /* Pascal record was empty */\n");
	return;
    }
    only_union = (mp && mp->kind == MK_VARIANT);
    fnames = NULL;
    while (mp && mp->kind == MK_FIELD) {
	flushcomments(&mp->comments, CMT_PRE, -1);
	output(storageclassname(varstorageclass(mp) & 0x10));
        outbasetype(mp->type, 0);
        output(" \005");
	for (;;) {
	    outdeclarator(mp->type, mp->name, 0);
	    if (mp->val.i && (mp->type != tp_abyte || mp->val.i != 8))
		output(format_d(" : %d", mp->val.i));
	    if (isfiletype(mp->type)) {
		fn = strlist_append(&fnames, mp->name);
		fn->value = (long)mp;
	    }
	    mp->wasdeclared = 1;
	    if (!mp->cnext || mp->cnext->kind != MK_FIELD ||
		varstorageclass(mp) != varstorageclass(mp->cnext) ||
		!mixable(mp, mp->cnext, 0, 0))
		break;
            mp = mp->cnext;
            output(",\001 ");
        }
        output(";");
	outtrailcomment(mp->comments, -1, declcommentindent);
	flushcomments(&mp->comments, -1, -1);
        mp = mp->cnext;
    }
    declarefiles(fnames);
    if (mp) {
	saveindent = outindent;
	empty = 1;
        if (!only_union) {
            output("union {\n");
	    moreindent(tabsize);
	    moreindent(structindent);
        }
        while (mp) {
            mp0 = mp->ctx;
            num = ord_value(mp->val);
            while (mp && mp->ctx == mp0)
                mp = mp->cnext;
            if (mp0) {
		empty = 0;
                if (!mp0->cnext && mp0->kind == MK_FIELD) {
                    outfieldlist(mp0);
                } else {
                    if (mp0->kind == MK_VARIANT)
                        output("union {\n");
                    else
                        output("struct {\n");
		    saveindent2 = outindent;
		    moreindent(tabsize);
		    moreindent(structindent);
                    outfieldlist(mp0);
		    outindent = saveindent2;
                    output("} ");
                    output(format_s(name_VARIANT, variantfieldname(num)));
                    output(";\n");
                }
		flushcomments(&mp0->comments, -1, -1);
            }
        }
	if (empty)
	    output("int empty_union;   /* Pascal variant record was empty */\n");
        if (!only_union) {
            outindent = saveindent;
            output("} ");
            output(format_s(name_UNION, ""));
            output(";\n");
        }
    }
}