decl.c

把pascal程序转成C语言程序 把pascal程序转成C语言程序

               (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", (char *)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", (char *)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;
	    if (!*editfmt)
		editfmt = useenum ? varformat : constformat;
	    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, 0) &&
	     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);
}



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, 1));
	    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, big)
Type *type;
int big;   /* 0=TK_FILE, 1=TK_BIGFILE, -1=either */
{
    return ((type->kind == TK_POINTER &&
	     type->basetype->kind == TK_FILE && big != 1) ||
	    (type->kind == TK_BIGFILE && big != 0));
}


int israndomfile(type)
Type *type;
{
    if (type->kind == TK_POINTER)
	type = type->basetype;
    return ((type->kind == TK_FILE || type->kind == TK_BIGFILE) &&
	    type->issigned);
}


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 *filebasetype(type)
Type *type;
{
    if (type->kind == TK_BIGFILE)
	return type->basetype;
    else
	return type->basetype->basetype;
}


Expr *filebasename(ex)
Expr *ex;
{
    if (ex->val.type->kind == TK_BIGFILE)
	return makeexpr_dotq(ex, "f", ex->val.type);
    else
	return ex;
}


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

    if (ex->val.type->kind == TK_BIGFILE)
	return makeexpr_dotq(copyexpr(ex), "name", tp_str255);
    else if ((mp = isfilevar(ex)) && mp->namedfile)
	if (mp->kind == MK_FIELD)
	    return makeexpr_dotq(copyexpr(ex->args[0]),
				 format_s(name_FNVAR, mp->name),
				 tp_str255);
	else
	    return makeexpr_name(format_s(name_FNVAR, mp->name), tp_str255);
    else
	return NULL;
}


int fileisbuffered(ex, maybe)
Expr *ex;
int maybe;
{
    Meaning *mp;

    return (ex->val.type->kind == TK_BIGFILE ||
	    ((mp = isfilevar(ex)) && (maybe || mp->bufferedfile)));
}



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

    for (;;) {
	if (type->preserved && (type->kind != TK_POINTER) &&
	    !(flags & ODECL_NOPRES))
	    return type;
        switch (type->kind) {

            case TK_POINTER:
	        if (type->smin)    /* unresolved forward */
		    return type;
                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) {
			    flags &= ~ODECL_CHARSTAR;
#ifdef PRES_PTR_ARRAY
			    type = type->basetype;
#else
			    type = type->basetype->basetype;
			    continue;
#endif
			}
                        break;

		    default:
			break;
                }
		if (type->preserved && !(flags & ODECL_NOPRES))
		    return type;
		if (type->fbase && type->fbase->wasdeclared &&
		    type->basetype->kind != TK_POINTER &&
		    (flags & ODECL_DECL)) {
		    typename.meaning = type->fbase;
		    typename.preserved = 1;
		    return &typename;
		}
                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;
		if (type->fbase && type->fbase->wasdeclared &&
		    (flags & ODECL_DECL)) {
		    typename.meaning = type->fbase;
		    typename.preserved = 1;
		    return &typename;
		}
                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 {