/* "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_DECL1_C
#include "trans.h"

#define MAXIMPORTS 100

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

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

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

Static int tempvarcount;

Static int stringtypecachesize;
Static Type **stringtypecache;

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

Static Type *tp_special_anyptr;

Static int wasaliased;
Static int deferallptrs;
Static int anydeferredptrs;
Static int silentalreadydef;
Static int nonloclabelcount;

Static Strlist *varstructdecllist;

Static Meaning *findstandardmeaning(kind, name)
enum meaningkind kind;
char *name;
{
    Meaning *mp;
    Symbol *sym;

    sym = findsymbol(fixpascalname(name));
    for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
    if (mp) {
	if (mp->kind == kind)
	    mp->refcount = 1;
	else
	    mp = NULL;
    }
    return mp;
}


Static Meaning *makestandardmeaning(kind, name)
enum meaningkind kind;
char *name;
{
    Meaning *mp;
    Symbol *sym;

    sym = findsymbol(fixpascalname(name));
    for (mp = sym->mbase; mp && mp->ctx != curctx; mp = mp->snext) ;
    if (!mp) {
        mp = addmeaning(sym, kind);
        strchange(&mp->name, stralloc(name));
        if (debug < 4)
            mp->dumped = partialdump;     /* prevent irrelevant dumping */
    } else {
        mp->kind = kind;
    }
    mp->refcount = 1;
    return mp;
}


Static Type *makestandardtype(kind, mp)
enum typekind kind;
Meaning *mp;
{
    Type *tp;

    tp = maketype(kind);
    tp->meaning = mp;
    if (mp)
        mp->type = tp;
    return tp;
}




Static Stmt *nullspecialproc(mp)
Meaning *mp;
{
    warning(format_s("Procedure %s not yet supported [118]", mp->name));
    if (curtok == TOK_LPAR)
        skipparens();
    return NULL;
}

Meaning *makespecialproc(name, handler)
char *name;
Stmt *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullspecialproc;
    mp = makestandardmeaning(MK_SPECIAL, name);
    mp->handler = (Expr *(*)())handler;
    return mp;
}



Static Stmt *nullstandardproc(ex)
Expr *ex;
{
    warning(format_s("Procedure %s not yet supported [118]", ((Meaning *)ex->val.i)->name));
    return makestmt_call(ex);
}

Meaning *makestandardproc(name, handler)
char *name;
Stmt *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullstandardproc;
    mp = findstandardmeaning(MK_FUNCTION, name);
    if (mp) {
	mp->handler = (Expr *(*)())handler;
	if (mp->isfunction) {
	    warning(format_s("Procedure %s was declared as a function [119]", name));
	    mp->isfunction = 0;
	}
    } else if (debug > 0)
	warning(format_s("Procedure %s was never declared [120]", name));
    return mp;
}



Static Expr *nullspecialfunc(mp)
Meaning *mp;
{
    warning(format_s("Function %s not yet supported [121]", mp->name));
    if (curtok == TOK_LPAR)
        skipparens();
    return makeexpr_long(0);
}

Meaning *makespecialfunc(name, handler)
char *name;
Expr *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullspecialfunc;
    mp = makestandardmeaning(MK_SPECIAL, name);
    mp->isfunction = 1;
    mp->handler = handler;
    return mp;
}



Static Expr *nullstandardfunc(ex)
Expr *ex;
{
    warning(format_s("Function %s not yet supported [121]", ((Meaning *)ex->val.i)->name));
    return ex;
}

Meaning *makestandardfunc(name, handler)
char *name;
Expr *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullstandardfunc;
    mp = findstandardmeaning(MK_FUNCTION, name);
    if (mp) {
	mp->handler = handler;
	if (!mp->isfunction) {
	    warning(format_s("Function %s was declared as a procedure [122]", name));
	    mp->isfunction = 1;
	}
    } else if (debug > 0)
	warning(format_s("Function %s was never declared [123]", name));
    return mp;
}




Static Expr *nullspecialvar(mp)
Meaning *mp;
{
    warning(format_s("Variable %s not yet supported [124]", mp->name));
    if (curtok == TOK_LPAR || curtok == TOK_LBR)
        skipparens();
    return makeexpr_var(mp);
}

Meaning *makespecialvar(name, handler)
char *name;
Expr *(*handler)();
{
    Meaning *mp;

    if (!handler)
        handler = nullspecialvar;
    mp = makestandardmeaning(MK_SPVAR, name);
    mp->handler = handler;
    return mp;
}





void setup_decl()
{
    Meaning *mp, *mp2, *mp_turbo_shortint;
    Symbol *sym;
    Type *tp;
    int i;

    numimports = 0;
    firstimport = 0;
    permimports = NULL;
    stringceiling = stringceiling | 1;   /* round up to odd */
    stringtypecachesize = (stringceiling + 1) >> 1;
    stringtypecache = ALLOC(stringtypecachesize, Type *, misc);
    curctxlast = NULL;
    curctx = NULL;   /* the meta-ctx has no parent ctx */
    curctx = nullctx = makestandardmeaning(MK_MODULE, "SYSTEM");
    strlist_add(&permimports, "SYSTEM")->value = (long)nullctx;
    ptrbase = NULL;
    tempvars = NULL;
    stmttempvars = NULL;
    tempvarcount = 0;
    deferallptrs = 0;
    silentalreadydef = 0;
    varstructdecllist = NULL;
    nonloclabelcount = -1;
    for (i = 0; i < stringtypecachesize; i++)
        stringtypecache[i] = NULL;

    tp_integer = makestandardtype(TK_INTEGER, makestandardmeaning(MK_TYPE,
                     (integer16) ? "LONGINT" : "INTEGER"));
    tp_integer->smin = makeexpr_long(MININT);             /* "long" */
    tp_integer->smax = makeexpr_long(MAXINT);

    if (sizeof_int >= 32) {
        tp_int = tp_integer;                              /* "int" */
    } else {
        tp_int = makestandardtype(TK_INTEGER,
                     (integer16 > 1) ? makestandardmeaning(MK_TYPE, "INTEGER")
				     : NULL);
        tp_int->smin = makeexpr_long(min_sshort);
        tp_int->smax = makeexpr_long(max_sshort);
    }
    mp = makestandardmeaning(MK_TYPE, "C_INT");
    mp->type = tp_int;
    if (!tp_int->meaning)
	tp_int->meaning = mp;

    mp_unsigned = makestandardmeaning(MK_TYPE, "UNSIGNED");
    tp_unsigned = makestandardtype(TK_INTEGER, mp_unsigned);
    tp_unsigned->smin = makeexpr_long(0);                 /* "unsigned long" */
    tp_unsigned->smax = makeexpr_long(MAXINT);

    if (sizeof_int >= 32) {
        tp_uint = tp_unsigned;                            /* "unsigned int" */
	mp_uint = mp_unsigned;
    } else {
	mp_uint = makestandardmeaning(MK_TYPE, "C_UINT");
        tp_uint = makestandardtype(TK_INTEGER, mp_uint);
        tp_uint->smin = makeexpr_long(0);
        tp_uint->smax = makeexpr_long(MAXINT);
    }

    tp_sint = makestandardtype(TK_INTEGER, NULL);
    tp_sint->smin = copyexpr(tp_int->smin);               /* "signed int" */
    tp_sint->smax = copyexpr(tp_int->smax);

    tp_char = makestandardtype(TK_CHAR, makestandardmeaning(MK_TYPE, "CHAR"));
    if (unsignedchar == 0) {
	tp_char->smin = makeexpr_long(-128);              /* "char" */
	tp_char->smax = makeexpr_long(127);
    } else {
	tp_char->smin = makeexpr_long(0);
	tp_char->smax = makeexpr_long(255);
    }

    tp_charptr = makestandardtype(TK_POINTER, NULL);      /* "unsigned char *" */
    tp_charptr->basetype = tp_char;
    tp_char->pointertype = tp_charptr;

    mp_schar = makestandardmeaning(MK_TYPE, "SCHAR");     /* "signed char" */
    tp_schar = makestandardtype(TK_CHAR, mp_schar);
    tp_schar->smin = makeexpr_long(-128);
    tp_schar->smax = makeexpr_long(127);

    mp_uchar = makestandardmeaning(MK_TYPE, "UCHAR");     /* "unsigned char" */
    tp_uchar = makestandardtype(TK_CHAR, mp_uchar);
    tp_uchar->smin = makeexpr_long(0);
    tp_uchar->smax = makeexpr_long(255);

    tp_boolean = makestandardtype(TK_BOOLEAN, makestandardmeaning(MK_TYPE, "BOOLEAN"));
    tp_boolean->smin = makeexpr_long(0);                  /* "boolean" */
    tp_boolean->smax = makeexpr_long(1);

    sym = findsymbol("Boolean");
    sym->flags |= SSYNONYM;
    strlist_append(&sym->symbolnames, "===")->value = (long)tp_boolean->meaning->sym;

    tp_real = makestandardtype(TK_REAL, makestandardmeaning(MK_TYPE, "REAL"));
                                                          /* "float" or "double" */
    mp = makestandardmeaning(MK_TYPE, "LONGREAL");
    if (doublereals)
	mp->type = tp_longreal = tp_real;
    else
	tp_longreal = makestandardtype(TK_REAL, mp);

    tp_void = makestandardtype(TK_VOID, NULL);            /* "void" */

    mp = makestandardmeaning(MK_TYPE, "SINGLE");
    if (doublereals)
	makestandardtype(TK_REAL, mp);
    else
	mp->type = tp_real;
    makestandardmeaning(MK_TYPE, "SHORTREAL")->type = mp->type;
    mp = makestandardmeaning(MK_TYPE, "DOUBLE");
    mp->type = tp_longreal;
    mp = makestandardmeaning(MK_TYPE, "EXTENDED");
    mp->type = tp_longreal;   /* good enough */
    mp = makestandardmeaning(MK_TYPE, "QUADRUPLE");
    mp->type = tp_longreal;   /* good enough */

    tp_sshort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE,
                  (integer16 == 1) ? "INTEGER" : "SWORD"));
    tp_sshort->basetype = tp_integer;                     /* "short" */
    tp_sshort->smin = makeexpr_long(min_sshort);
    tp_sshort->smax = makeexpr_long(max_sshort);

    if (integer16) {
	if (integer16 != 2) {
	    mp = makestandardmeaning(MK_TYPE, "SWORD");
	    mp->type = tp_sshort;
	}
    } else {
	mp = makestandardmeaning(MK_TYPE, "LONGINT");
	mp->type = tp_integer;
    }

    tp_ushort = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, modula2 ? "UWORD" : "WORD"));
    tp_ushort->basetype = tp_integer;                     /* "unsigned short" */
    tp_ushort->smin = makeexpr_long(0);
    tp_ushort->smax = makeexpr_long(max_ushort);

    mp = makestandardmeaning(MK_TYPE, "CARDINAL");
    mp->type = (integer16) ? tp_ushort : tp_unsigned;
    mp = makestandardmeaning(MK_TYPE, "LONGCARD");
    mp->type = tp_unsigned;

    if (modula2) {
	mp = makestandardmeaning(MK_TYPE, "WORD");
	mp->type = tp_integer;
    } else {
	makestandardmeaning(MK_TYPE, "UWORD")->type = tp_ushort;
    }

    tp_sbyte = makestandardtype(TK_SUBR, NULL);           /* "signed char" */
    tp_sbyte->basetype = tp_integer;
    tp_sbyte->smin = makeexpr_long(min_schar);
    tp_sbyte->smax = makeexpr_long(max_schar);

    mp_turbo_shortint = (which_lang == LANG_TURBO) ? makestandardmeaning(MK_TYPE, "SHORTINT") : NULL;
    mp = makestandardmeaning(MK_TYPE, "SBYTE");
    if (needsignedbyte || signedchars == 1 || hassignedchar) {
	mp->type = tp_sbyte;
	if (mp_turbo_shortint)
	    mp_turbo_shortint->type = tp_sbyte;
	tp_sbyte->meaning = mp_turbo_shortint ? mp_turbo_shortint : mp;
    } else {
	mp->type = tp_sshort;
	if (mp_turbo_shortint)
	    mp_turbo_shortint->type = tp_sshort;
    }

    tp_ubyte = makestandardtype(TK_SUBR, makestandardmeaning(MK_TYPE, "BYTE"));
    tp_ubyte->basetype = tp_integer;                      /* "unsigned char" */
    tp_ubyte->smin = makeexpr_long(0);
    tp_ubyte->smax = makeexpr_long(max_uchar);

    if (signedchars == 1)
        tp_abyte = tp_sbyte;                              /* "char" */
    else if (signedchars == 0)
        tp_abyte = tp_ubyte;
    else {
        tp_abyte = makestandardtype(TK_SUBR, NULL);
        tp_abyte->basetype = tp_integer;
        tp_abyte->smin = makeexpr_long(0);
        tp_abyte->smax = makeexpr_long(max_schar);
    }

    mp = makestandardmeaning(MK_TYPE, "POINTER");
    mp2 = makestandardmeaning(MK_TYPE, "ANYPTR");
    tp_anyptr = makestandardtype(TK_POINTER, (which_lang == LANG_HP) ? mp2 : mp);
    ((which_lang == LANG_HP) ? mp : mp2)->type = tp_anyptr;
    tp_anyptr->basetype = tp_void;                        /* "void *" */
    tp_void->pointertype = tp_anyptr;

    if (useAnyptrMacros == 1) {
        tp_special_anyptr = makestandardtype(TK_SUBR, NULL);
        tp_special_anyptr->basetype = tp_integer;
        tp_special_anyptr->smin = makeexpr_long(0);
        tp_special_anyptr->smax = makeexpr_long(max_schar);
    } else
        tp_special_anyptr = NULL;

    tp_proc = maketype(TK_PROCPTR);
    tp_proc->basetype = maketype(TK_FUNCTION);
    tp_proc->basetype->basetype = tp_void;
    tp_proc->escale = 1;   /* saved "hasstaticlinks" */

    tp_str255 = makestandardtype(TK_STRING, NULL);             /* "Char []" */
    tp_str255->basetype = tp_char;
    tp_str255->indextype = makestandardtype(TK_SUBR, NULL);
    tp_str255->indextype->basetype = tp_integer;
    tp_str255->indextype->smin = makeexpr_long(0);
    tp_str255->indextype->smax = makeexpr_long(stringceiling);

    tp_strptr = makestandardtype(TK_POINTER, NULL);            /* "Char *" */
    tp_str255->pointertype = tp_strptr;
    tp_strptr->basetype = tp_str255;

    mp_string = makestandardmeaning(MK_TYPE, "STRING");
    tp = makestandardtype(TK_STRING, mp_string);
    tp->basetype = tp_char;
    tp->indextype = tp_str255->indextype;

    tp_smallset = maketype(TK_SMALLSET);
    tp_smallset->basetype = tp_integer;
    tp_smallset->indextype = tp_boolean;

    tp_text = makestandardtype(TK_POINTER, makestandardmeaning(MK_TYPE, "TEXT"));
    tp_text->basetype = makestandardtype(TK_FILE, NULL);       /* "FILE *" */
    tp_text->basetype->basetype = tp_char;
    tp_text->basetype->pointertype = tp_text;

    tp_jmp_buf = makestandardtype(TK_SPECIAL, NULL);

    mp = makestandardmeaning(MK_TYPE, "INTERACTIVE");
    mp->type = tp_text;

    mp = makestandardmeaning(MK_TYPE, "BITSET");
    mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
					    makeexpr_long(setbits-1)));
    mp->type->meaning = mp;

    mp = makestandardmeaning(MK_TYPE, "INTSET");
    mp->type = makesettype(makesubrangetype(tp_integer, makeexpr_long(0),
					    makeexpr_long(defaultsetsize-1)));
    mp->type->meaning = mp;

    mp_input = makestandardmeaning(MK_VAR, "INPUT");
    mp_input->type = tp_text;
    mp_input->name = stralloc("stdin");
    ex_input = makeexpr_var(mp_input);

    mp_output = makestandardmeaning(MK_VAR, "OUTPUT");
    mp_output->type = tp_text;
    mp_output->name = stralloc("stdout");
    ex_output = makeexpr_var(mp_output);

    mp_stderr = makestandardmeaning(MK_VAR, "STDERR");
    mp_stderr->type = tp_text;
    mp_stderr->name = stralloc("stderr");

    mp_escapecode = makestandardmeaning(MK_VAR, "ESCAPECODE");
    mp_escapecode->type = tp_sshort;
    mp_escapecode->name = stralloc(name_ESCAPECODE);

    mp_ioresult = makestandardmeaning(MK_VAR, "IORESULT");
    mp_ioresult->type = tp_integer;
    mp_ioresult->name = stralloc(name_IORESULT);

    mp_false = makestandardmeaning(MK_CONST, "FALSE");
    mp_false->type = mp_false->val.type = tp_boolean;
    mp_false->val.i = 0;

    mp_true = makestandardmeaning(MK_CONST, "TRUE");
    mp_true->type = mp_true->val.type = tp_boolean;
    mp_true->val.i = 1;

    mp_maxint = makestandardmeaning(MK_CONST, "MAXINT");
    mp_maxint->type = mp_maxint->val.type = tp_integer;
    mp_maxint->val.i = MAXINT;
    mp_maxint->name = stralloc((integer16) ? "SHORT_MAX" :
                               (sizeof_int >= 32) ? "INT_MAX" : "LONG_MAX");

    mp = makestandardmeaning(MK_CONST, "MAXLONGINT");
    mp->type = mp->val.type = tp_integer;
    mp->val.i = MAXINT;
    mp->name = stralloc("LONG_MAX");

    mp_minint = makestandardmeaning(MK_CONST, "MININT");
    mp_minint->type = mp_minint->val.type = tp_integer;
    mp_minint->val.i = MININT;
    mp_minint->name = stralloc((integer16) ? "SHORT_MIN" :
                               (sizeof_int >= 32) ? "INT_MIN" : "LONG_MIN");

    mp = makestandardmeaning(MK_CONST, "MAXCHAR");
    mp->type = mp->val.type = tp_char;
    mp->val.i = 127;
    mp->name = stralloc("CHAR_MAX");

    mp = makestandardmeaning(MK_CONST, "MINCHAR");
    mp->type = mp->val.type = tp_char;
    mp->val.i = 0;
    mp->anyvarflag = 1;

    mp = makestandardmeaning(MK_CONST, "BELL");
    mp->type = mp->val.type = tp_char;
    mp->val.i = 7;
    mp->anyvarflag = 1;

    mp = makestandardmeaning(MK_CONST, "TAB");
    mp->type = mp->val.type = tp_char;
    mp->val.i = 9;
    mp->anyvarflag = 1;

    mp_str_hp = mp_str_turbo = NULL;
    mp_val_modula = mp_val_turbo = NULL;
    mp_blockread_ucsd = mp_blockread_turbo = NULL;
    mp_blockwrite_ucsd = mp_blockwrite_turbo = NULL;
    mp_dec_dec = mp_dec_turbo = NULL;
}



/* This makes sure that if A imports B and then C, C's interface is not
   parsed in the environment of B */
int push_imports()
{
    int mark = firstimport;
    Meaning *mp;

    while (firstimport < numimports) {
	if (!strlist_cifind(permimports, importlist[firstimport]->sym->name)) {
	    for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
		mp->isactive = 0;
	}
        firstimport++;
    }
    return mark;
}



void pop_imports(mark)
int mark;
{
    Meaning *mp;

    while (firstimport > mark) {
        firstimport--;
        for (mp = importlist[firstimport]->cbase; mp; mp = mp->cnext)
            mp->isactive = 1;
    }
}



void import_ctx(ctx)
Meaning *ctx;
{
    Meaning *mp;
    int i;

    for (i = firstimport; i < numimports && importlist[i] != ctx; i++) ;
    if (i >= numimports) {
        if (numimports == MAXIMPORTS)
            error(format_d("Maximum of %d simultaneous imports exceeded", MAXIMPORTS));
        importlist[numimports++] = ctx;
    }
    for (mp = ctx->cbase; mp; mp = mp->cnext) {
        if (mp->exported)
            mp->isactive = 1;
    }
}



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

    /* Import permanently, as in Turbo's "system" unit */
    for (mp = ctx->cbase; mp; mp = mp->cnext) {
        if (mp->exported)
            mp->isactive = 1;
    }
}



void unimport(mark)
int mark;
{
    Meaning *mp;

    while (numimports > mark) {
        numimports--;
	if (!strlist_cifind(permimports, importlist[numimports]->sym->name)) {
	    for (mp = importlist[numimports]->cbase; mp; mp = mp->cnext)
		mp->isactive = 0;
	}
    }
}




void activatemeaning(mp)
Meaning *mp;
{
    Meaning *mp2;

    if (debug>1) fprintf(outf, "Reviving %s\n", curctxlast->name);
    mp->isactive = 1;
    if (mp->sym->mbase != mp) {     /* move to front of symbol list */
        mp2 = mp->sym->mbase;
        for (;;) {
            if (!mp2) {
		/* Not on symbol list: must be a special kludge meaning */
                return;
            }
            if (mp2->snext == mp)
                break;
            mp2 = mp2->snext;
        }
        mp2->snext = mp->snext;
        mp->snext = mp->sym->mbase;
        mp->sym->mbase = mp;
    }
}



void pushctx(ctx)
Meaning *ctx;
{
    struct ctxstack *top;

    top = ALLOC(1, struct ctxstack, ctxstacks);
    top->ctx = curctx;
    top->ctxlast = curctxlast;
    top->tempvars = tempvars;
    top->tempvarcount = tempvarcount;
    top->importmark = numimports;
    top->next = ctxtop;
    ctxtop = top;
    curctx = ctx;
    curctxlast = ctx->cbase;
    if (curctxlast) {
        activatemeaning(curctxlast);
        while (curctxlast->cnext) {
            curctxlast = curctxlast->cnext;
            activatemeaning(curctxlast);
        }
    }
    tempvars = NULL;
    tempvarcount = 0;
    if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
	progress();
}



void popctx()
{
    struct ctxstack *top;
    struct tempvarlist *tv;
    Meaning *mp;

    if (!strlist_cifind(permimports, curctx->sym->name)) {
	for (mp = curctx->cbase; mp; mp = mp->cnext) {
	    if (debug>1) fprintf(outf, "Hiding %s\n", mp->name);
	    mp->isactive = 0;
	}
    }
    top = ctxtop;
    ctxtop = top->next;
    curctx = top->ctx;
    curctxlast = top->ctxlast;
    while (tempvars) {
        tv = tempvars->next;
        FREE(tempvars);
        tempvars = tv;
    }
    tempvars = top->tempvars;
    tempvarcount = top->tempvarcount;
    unimport(top->importmark);
    FREE(top);
    if (blockkind != TOK_IMPORT && blockkind != TOK_EXPORT)
	progress();
}



void forget_ctx(ctx, all)
Meaning *ctx;
int all;
{
    register Meaning *mp, **mpprev, *mp2, **mpp2;

    if (ctx->kind == MK_FUNCTION && ctx->isfunction && ctx->cbase)
	mpprev = &ctx->cbase->cnext;   /* Skip return-value variable */
    else
	mpprev = &ctx->cbase;
    while ((mp = *mpprev) != NULL) {
	if (all ||
	    (mp->kind != MK_PARAM &&
	     mp->kind != MK_VARPARAM)) {
	    *mpprev = mp->cnext;
	    mpp2 = &mp->sym->mbase;
	    while ((mp2 = *mpp2) != NULL && mp2 != mp)
		mpp2 = &mp2->snext;
	    if (mp2)
		*mpp2 = mp2->snext;
	    if (mp->kind == MK_CONST)
		free_value(&mp->val);
	    freeexpr(mp->constdefn);
	    if (mp->cbase)
		forget_ctx(mp, 1);
	    if (mp->kind == MK_FUNCTION && mp->val.i)
		free_stmt((Stmt *)mp->val.i);
	    strlist_empty(&mp->comments);
	    if (mp->name)
		FREE(mp->name);
	    if (mp->othername)
		FREE(mp->othername);
	    FREE(mp);
	} else
	    mpprev = &mp->cnext;
    }
}




void handle_nameof()
{
    Strlist *sl, *sl2;
    Symbol *sp;
    char *cp;

    for (sl = nameoflist; sl; sl = sl->next) {
        cp = my_strchr(sl->s, '.');
        if (cp) {
            sp = findsymbol(fixpascalname(cp + 1));
            sl2 = strlist_add(&sp->symbolnames, 
                              format_ds("%.*s", (int)(cp - sl->s), sl->s));
        } else {
            sp = findsymbol(fixpascalname(sl->s));
            sl2 = strlist_add(&sp->symbolnames, "");
        }
        sl2->value = sl->value;
        if (debug > 0)
            fprintf(outf, "symbol %s gets \"%s\" -> \"%s\"\n",
                          sp->name, sl2->s, sl2->value);
    }
    strlist_empty(&nameoflist);
}



Static void initmeaning(mp)
Meaning *mp;
{
/*    mp->serial = curserial = ++serialcount;    */
    mp->cbase = NULL;
    mp->xnext = NULL;
    mp->othername = NULL;
    mp->type = NULL;
    mp->needvarstruct = 0;
    mp->varstructflag = 0;
    mp->wasdeclared = 0;
    mp->isforward = 0;
    mp->isfunction = 0;
    mp->istemporary = 0;
    mp->volatilequal = 0;
    mp->constqual = 0;
    mp->warnifused = (warnnames > 0);
    mp->constdefn = NULL;
    mp->val.i = 0;
    mp->val.s = NULL;
    mp->val.type = NULL;
    mp->refcount = 1;
    mp->anyvarflag = 0;
    mp->isactive = 1;
    mp->exported = 0;
    mp->handler = NULL;
    mp->dumped = 0;
    mp->isreturn = 0;
    mp->fakeparam = 0;
    mp->namedfile = 0;
    mp->bufferedfile = 0;
    mp->comments = NULL;
}



int issafename(sp, isglobal, isdefine)
Symbol *sp;
int isglobal, isdefine;
{
    if (isdefine && curctx->kind != MK_FUNCTION) {
	if (sp->flags & FWDPARAM)
	    return 0;
    }
    if ((sp->flags & AVOIDNAME) ||
	(isdefine && (sp->flags & AVOIDFIELD)) ||
        (isglobal && (sp->flags & AVOIDGLOB)))
        return 0;
    else
        return 1;
}

Meaning *enum_tname;

void setupmeaning(mp, sym, kind, namekind)
Meaning *mp;
Symbol *sym;
enum meaningkind kind, namekind;
{
    char *name, *symfmt, *editfmt, *cp, *cp2;
    int altnum, isglobal, isdefine;
    Symbol *sym2;
    Strlist *sl;

    if (!sym)
	sym = findsymbol("Spam");   /* reduce crashes due to internal errors */
    if (sym->mbase && sym->mbase->ctx == curctx &&
	curctx != NULL && !silentalreadydef)
        alreadydef(sym);
    mp->sym = sym;
    mp->snext = sym->mbase;
    sym->mbase = mp;
    if (sym == curtoksym) {
	sym->kwtok = TOK_NONE;
	sym->flags &= ~KWPOSS;
    }
    mp->ctx = curctx;
    mp->kind = kind;
    if (pascalcasesens && curctx && curctx->sym && kind != MK_SYNONYM &&
	strlist_cifind(permimports, curctx->sym->name)) { /* a built-in name */
	Meaning *mp2;
	if (islower(sym->name[0]))
	    sym2 = findsymbol(strupper(sym->name));
	else
	    sym2 = findsymbol(strlower(sym->name));
	mp2 = addmeaning(sym2, MK_SYNONYM);
	mp2->xnext = mp;
    }
    if (kind == MK_VAR) {
        sl = strlist_find(varmacros, sym->name);
        if (sl) {
            kind = namekind = MK_VARMAC;
            mp->constdefn = (Expr *)sl->value;
            strlist_delete(&varmacros, sl);
        }
    }
    if (kind == MK_FUNCTION || kind == MK_SPECIAL) {
        sl = strlist_find(funcmacros, sym->name);
        if (sl) {
            mp->constdefn = (Expr *)sl->value;
            strlist_delete(&funcmacros, sl);
        }
    }
    if (kind == MK_VAR || kind == MK_VARREF || kind == MK_VARMAC ||
	kind == MK_TYPE || kind == MK_CONST || kind == MK_FUNCTION) {
        mp->exported = (blockkind == TOK_IMPORT || blockkind == TOK_EXPORT);
	if (blockkind == TOK_IMPORT)
	    mp->wasdeclared = 1;   /* suppress future declaration */
    } else
        mp->exported = 0;
    if (sym == curtoksym)
        name = curtokcase;
    else
        name = sym->name;
    isdefine = (namekind == MK_CONST);
    isglobal = (!curctx ||
		curctx->kind != MK_FUNCTION ||
                namekind == MK_FUNCTION ||
		namekind == MK_TYPE ||
                isdefine) &&
               (curctx != nullctx);
    mp->refcount = isglobal ? 1 : 0;   /* make sure globals don't disappear */
    if (namekind == MK_SYNONYM)
	return;
    if (!mp->exported || !*exportsymbol)
        symfmt = "";
    else if (*export_symbol && my_strchr(name, '_'))
        symfmt = export_symbol;
    else
        symfmt = exportsymbol;
    wasaliased = 0;
    if (*externalias && !my_strchr(externalias, '%')) {
        register int i;
        name = format_s("%s", externalias);
        i = numparams;
        while (--i >= 0 && strcmp(rctable[i].name, "ALIAS")) ;
        if (i < 0 || !undooption(i, ""))
            *externalias = 0;
        wasaliased = 1;
    } else if (sym->symbolnames) {
        if (curctx) {
            if (debug > 2)
                fprintf(outf, "checking for \"%s\" of %s\n", curctx->name, sym->name);
            sl = strlist_cifind(sym->symbolnames, curctx->sym->name);
            if (sl) {
                if (debug > 2)
                    fprintf(outf, "found \"%s\"\n", sl->value);
                name = (char *)sl->value;
                wasaliased = 1;
            }
        }
        if (!wasaliased) {
            if (debug > 2)
                fprintf(outf, "checking for \"\" of %s\n", sym->name);
            sl = strlist_find(sym->symbolnames, "");
            if (sl) {
                if (debug > 2)
                    fprintf(outf, "found \"%s\"\n", sl->value);
                name = (char *)sl->value;
                wasaliased = 1;
            }
        }
    }
    if (!*symfmt || wasaliased)
	symfmt = "%s";
    altnum = -1;
    do {
        altnum++;
        cp = format_ss(symfmt, name, curctx ? curctx->name : "");
	switch (namekind) {

	  case MK_CONST:
	    editfmt = constformat;
	    break;

	  case MK_MODULE:
	    editfmt = moduleformat;
	    break;

	  case MK_FUNCTION:
	    editfmt = functionformat;
	    break;

	  case MK_VAR:
	  case MK_VARPARAM:
	  case MK_VARREF:
	  case MK_VARMAC:
	  case MK_SPVAR:
	    editfmt = varformat;
	    break;

	  case MK_TYPE:
	    editfmt = typeformat;
	    break;

	  case MK_VARIANT:   /* A true kludge! */
	    editfmt = enumformat;
	    break;

	  default:
	    editfmt = "";
	}
	if (!*editfmt)
	    editfmt = symbolformat;
	if (*editfmt)
	    if (editfmt == enumformat)
		cp = format_ss(editfmt, cp,
			       enum_tname ? enum_tname->name : "ENUM");
	    else
		cp = format_ss(editfmt, cp,
			       curctx ? curctx->name : "");
	if (dollar_idents == 2) {
	    for (cp2 = cp; *cp2; cp2++)
		if (*cp2 == '$' || *cp2 == '%')
		    *cp2 = '_';
	}
        sym2 = findsymbol(findaltname(cp, altnum));
    } while (!issafename(sym2, isglobal, isdefine) &&
	     namekind != MK_MODULE && !wasaliased);
    mp->name = stralloc(sym2->name);
    if (sym2->flags & WARNNAME)
        note(format_s("A symbol named %s was defined [100]", mp->name));
    if (isglobal) {
        switch (namekind) {     /* prevent further name conflicts */

            case MK_CONST:
	    case MK_VARIANT:
            case MK_TYPE:
                sym2->flags |= AVOIDNAME;
                break;

            case MK_VAR:
            case MK_VARREF:
            case MK_FUNCTION:
                sym2->flags |= AVOIDGLOB;
                break;

	    default:
		/* name is completely local */
		break;
        }
    }
    if (debug > 4)
	fprintf(outf, "Created meaning %s\n", mp->name);
}