decl.c

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

	if (type->smin)
	    return type;
        else 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 identicaltypes(t1, t2)
Type *t1, *t2;
{
    if (t1 == t2)
	return 1;
    if (t1->kind == t2->kind) {
	if (t1->kind == TK_SUBR)
	    return (identicaltypes(t1->basetype, t2->basetype) &&
		    exprsame(t1->smin, t2->smin, 2) &&
		    exprsame(t1->smax, t2->smax, 2));
	if (t1->kind == TK_SET ||
	    t1->kind == TK_SMALLSET)
	    return (exprsame(t1->indextype->smax,
			     t2->indextype->smax, 2));
	if (t1->kind == TK_ARRAY ||
	    t1->kind == TK_STRING ||
	    t1->kind == TK_SMALLARRAY)
	    return (identicaltypes(t1->basetype, t2->basetype) &&
		    identicaltypes(t1->indextype, t2->indextype) &&
		    t1->structdefd == t2->structdefd &&
		    ((!t1->smin && !t2->smin) ||
		     (t1->smin && t2->smin &&
		      exprsame(t1->smin, t2->smin, 2))) &&
		    ((!t1->smax && !t2->smax) ||
		     (t1->smax && t2->smax &&
		      exprsame(t1->smax, t2->smax, 2) &&
		      t1->escale == t2->escale &&
		      t1->issigned == t2->issigned)));
    }
    return 0;
}


int similartypes(t1, t2)
Type *t1, *t2;
{
    if (debug > 3) { fprintf(outf, "similartypes("); dumptypename(t1,1); fprintf(outf, ","); dumptypename(t2,1); fprintf(outf, ") = %d\n", identicaltypes(t1, t2)); }
    if (identicaltypes(t1, t2))
	return 1;
    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));
}


int tinyexpr(ex)
Expr *ex;
{
    if (ex->kind == EK_CONST || ex->kind == EK_LONGCONST) {
	if (ex->val.type->kind == TK_INTEGER ||
	    (ex->val.type->kind == TK_REAL && strlen(ex->val.s) < 8) ||
	    ex->val.type->kind == TK_CHAR ||
	    (ex->val.type->kind == TK_POINTER && ex->val.i == 0) ||
	    (ex->val.type->kind == TK_SMALLSET && ex->val.i == 0) ||
	    ex->val.type->kind == TK_BOOLEAN ||
	    (ex->val.type->kind == TK_STRING && ex->val.i <= 3))
	    return 1;
    } else if (ex->kind == EK_VAR) {
	if (strlen(((Meaning *)ex->val.i)->name) < 8)
	    return 1;
    }
    return 0;
}


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 && tinyexpr(mp2->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->smin && tp1->basetype)
                tp1 = tp1->basetype;
            while (tp2->kind == TK_POINTER && !tp2->smin && 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, 0);
		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->kind == TK_RECORD &&
	    tp->fbase && tp->fbase->kind == MK_VARIANT);
}


void outfieldlist(mp)
Meaning *mp;
{
    Meaning *mp0;
    int num, flags, only_union, empty, saveindent, saveindent2;
    int isprivate = 0;
    Type *virtdestr = NULL;
    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_VARIANT) {
	if (mp->isreturn && !isprivate) {
	    output("private:\n");
	    isprivate = 1;
	}
	flushcomments(&mp->comments, CMT_PRE, -1);
	output(storageclassname(varstorageclass(mp) & 0x10));
	if (mp->kind == MK_FUNCTION && mp->bufferedfile)
	    output("virtual ");
	if (mp->dtype)
	    output(mp->dtype->name);
	else
	    outbasetype(mp->type, 0);
	flags = 0;
	if (mp->dtype)
	    output(" \005");
	else
	    flags = ODECL_SPACE|ODECL_SPMRG;
	for (;;) {
	    if (mp->dtype)
		output(mp->name);
	    else
		outdeclarator(mp->type, mp->name, flags);
	    flags = 0;
	    if (mp->val.i && (mp->type != tp_abyte || mp->val.i != 8))
		output(format_d(" : %d", mp->val.i));
	    if (isfiletype(mp->type, 0)) {
		fn = strlist_append(&fnames, mp->name);
		fn->value = (long)mp;
	    }
	    mp->wasdeclared = 1;
	    if (mp->kind == MK_FUNCTION && mp->val.s && mp->val.s[0] == 'D' &&
		mp->bufferedfile)
		virtdestr = mp->rectype;
	    if (!mp->cnext || mp->cnext->kind == MK_VARIANT ||
		mp->dtype != mp->cnext->dtype ||
		varstorageclass(mp) != varstorageclass(mp->cnext) ||
		!mixable(mp, mp->cnext, 0, 0))
		break;
            mp = mp->cnext;
	    if (spacecommas)
		output(",\001 ");
	    else
		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) {
		    mp0->val.i = 0;   /* no need for bit fields in a union! */
                    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("}");
	    if (!anonymousunions) {
		output(" ");
		output(format_s(name_UNION, ""));
	    }
            output(";\n");
        }
    }
    if (virtdestr) {
	output(format_s("virtual ~%s() { }\n", virtdestr->meaning->name));
    }
}



void declarebigfile(type)
Type *type;
{
    output("FILE *f;\n");
    if (!*declbufncname) {
	output(declbufname);
	output("(f,,");
    } else {
	output(declbufncname);
	output("(f,");
    }
    out_type(type->basetype, 0);
    output(");\n");
    output(charname);
    output(format_s(" name[%s];\n", *name_FNSIZE ? name_FNSIZE : "80"));
}



void outbasetype(type, flags)
Type *type;
int flags;
{
    Meaning *mp;
    int saveindent;

    type = findbasetype(type, flags | ODECL_DECL);
    if (type->preserved && type->meaning->wasdeclared) {
	output(type->meaning->name);
	return;
    }
    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->kind == TK_POINTER && type->smin) {
		note("Forward pointer reference assumes struct type [323]");
		output("struct ");
		output(format_s(name_STRUCT, type->smin->val.s));
	    } else if (type->meaning && type->meaning->kind == MK_TYPE &&
                type->meaning->wasdeclared) {
                output(type->meaning->name);
            } else {
                switch (type->kind) {

                    case TK_ENUM:
                        output("enum ");
			if (cplus > 0 && type->meaning)
			    output(format_s("%s ", type->meaning->name));
                        output("{\n");
			saveindent = outindent;
			moreindent(tabsize);
			moreindent(structindent);
                        mp = type->fbase;
                        while (mp) {
                            output(mp->name);
                            mp = mp->xnext;
                            if (mp)
				if (spacecommas)
				    output(",\001 ");
				else
				    output(",\001");
                        }
                        outindent = saveindent;
                        output("\n}");
                        break;

                    case TK_RECORD:
                    case TK_BIGFILE:
			if (type->issigned && type->kind == TK_RECORD)
			    output("class ");
			else if (record_is_union(type))
                            output("union ");
                        else
                            output("struct ");
                        if (type->meaning)
                            output(format_s(name_STRUCT, type->meaning->name));
			else if (type->smin)
			    o