parse.c

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

/* "p2c", a Pascal to C translator.
   Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation.
   Author's address: [e-mail].

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_PARSE_C
#include "trans.h"



Static int trycount;
Static Strlist *includedfiles;
Static char echo_first;
Static int echo_pos;



void setup_parse()
{
    trycount = 0;
    includedfiles = NULL;
    echo_first = 1;
    echo_pos = 0;
    fixexpr_tryblock = 0;
}



void echobreak()
{
    if (echo_pos > 0) {
	printf("\n");
	echo_pos = 0;
	echo_first = 0;
    }
}


void echoword(name, comma)
char *name;
int comma;
{
#ifndef NO_ECHOWORD
    FILE *f = (outf == stdout) ? stderr : stdout;

    if (quietmode || showprogress)
        return;
    if (!echo_first) {
	if (comma) {
	    fprintf(f, ",");
	    echo_pos++;
	}
        if (echo_pos + strlen(name) > 77) {
            fprintf(f, "\n");
            echo_pos = 0;
        } else {
            fprintf(f, " ");
            echo_pos++;
        }
    }
    echo_first = 0;
    fprintf(f, "%s", name);
    echo_pos += strlen(name);
    fflush(f);
#endif
}



void echoprocname(mp)
Meaning *mp;
{
    echoword(mp->name, 1);
}





Static void forward_decl(func, isextern)
Meaning *func;
int isextern;
{
    int flags = 0;
    if (func->wasdeclared)
        return;
    if (isextern && func->constdefn && !checkvarmac(func))
	return;
    if (isextern) {
        output("extern ");
    } else if (func->ctx->kind == MK_FUNCTION) {
	if (useAnyptrMacros)
	    output("Local ");
	else
	    output("static ");
    } else if ((use_static != 0 && !useAnyptrMacros) ||
	       (findsymbol(func->name)->flags & NEEDSTATIC)) {
	output("static ");
    } else if (use_static && useAnyptrMacros) {
	output("Static ");
    }
    if (func->type->basetype != tp_void || ansiC != 0) {
	if (func->type->smin)
	    output(func->type->smin->val.s);
	else
	    outbasetype(func->type, ODECL_FORWARD);
	flags = ODECL_SPACE;
    }
    outdeclarator(func->type, func->name, ODECL_FORWARD | flags);
    output(";\n");
    func->wasdeclared = 1;
}




/* Check if calling a parent procedure, whose body must */
/*   be declared forward */

void need_forward_decl(func)
Meaning *func;
{
    Meaning *mp;

    if (func->wasdeclared)
        return;
    for (mp = curctx->ctx; mp; mp = mp->ctx) {
        if (mp == func) {
	    if (func->ctx->kind == MK_FUNCTION)
		func->isforward = 1;
	    else
		forward_decl(func, 0);
            return;
        }
    }
}




void free_stmt(sp)
register Stmt *sp;
{
    if (sp) {
        free_stmt(sp->stm1);
        free_stmt(sp->stm2);
        free_stmt(sp->next);
        freeexpr(sp->exp1);
        freeexpr(sp->exp2);
        freeexpr(sp->exp3);
        FREE(sp);
    }
}




Stmt *makestmt(kind)
enum stmtkind kind;
{
    Stmt *sp;

    sp = ALLOC(1, Stmt, stmts);
    sp->kind = kind;
    sp->next = NULL;
    sp->stm1 = NULL;
    sp->stm2 = NULL;
    sp->exp1 = NULL;
    sp->exp2 = NULL;
    sp->exp3 = NULL;
    sp->serial = curserial = ++serialcount;
    sp->trueprops = sp->falseprops = 0;
    sp->quietelim = 0;
    sp->doinit = 0;
    return sp;
}



Stmt *makestmt_call(call)
Expr *call;
{
    Stmt *sp = makestmt(SK_ASSIGN);
    sp->exp1 = call;
    return sp;
}



Stmt *makestmt_assign(lhs, rhs)
Expr *lhs, *rhs;
{
    Stmt *sp = makestmt(SK_ASSIGN);
    sp->exp1 = makeexpr_assign(lhs, rhs);
    return sp;
}



Stmt *makestmt_if(cond, thn, els)
Expr *cond;
Stmt *thn, *els;
{
    Stmt *sp = makestmt(SK_IF);
    sp->exp1 = cond;
    sp->stm1 = thn;
    sp->stm2 = els;
    sp->quietelim = 1;
    return sp;
}



Stmt *makestmt_seq(s1, s2)
Stmt *s1, *s2;
{
    Stmt *s1a;

    if (!s1)
        return s2;
    if (!s2)
        return s1;
    for (s1a = s1; s1a->next; s1a = s1a->next) ;
    s1a->next = s2;
    return s1;
}



Stmt *copystmt(sp)
Stmt *sp;
{
    Stmt *sp2;

    if (sp) {
        sp2 = makestmt(sp->kind);
        sp2->stm1 = copystmt(sp->stm1);
        sp2->stm2 = copystmt(sp->stm2);
        sp2->exp1 = copyexpr(sp->exp1);
        sp2->exp2 = copyexpr(sp->exp2);
        sp2->exp3 = copyexpr(sp->exp3);
        return sp2;
    } else
        return NULL;
}



void nukestmt(sp)
Stmt *sp;
{
    if (sp) {
        sp->kind = SK_ASSIGN;
        sp->exp1 = makeexpr_long(0);
    }
}



void splicestmt(sp, spnew)
Stmt *sp, *spnew;
{
    Stmt *snext;

    if (spnew) {
	snext = sp->next;
	*sp = *spnew;
	while (sp->next)
	    sp = sp->next;
	sp->next = snext;
    } else
	nukestmt(sp);
}



int stmtcount(sp)
Stmt *sp;
{
    int i = 0;

    while (sp) {
        i += 1 + stmtcount(sp->stm1) + stmtcount(sp->stm2);
        sp = sp->next;
    }
    return i;
}





Stmt *close_files_to_ctx(ctx)
Meaning *ctx;
{
    Meaning *ctx2, *mp;
    Stmt *splist = NULL, *sp;

    ctx2 = curctx;
    while (ctx2 && ctx2 != ctx && ctx2->kind == MK_FUNCTION) {
	for (mp = ctx2->cbase; mp; mp = mp->cnext) {
	    if (mp->kind == MK_VAR &&
		isfiletype(mp->type, -1) && !mp->istemporary) {
		var_reference(mp);
		sp = makestmt_if(makeexpr_rel(EK_NE,
					      filebasename(makeexpr_var(mp)),
					      makeexpr_nil()),
				 makestmt_call(
				     makeexpr_bicall_1("fclose", tp_void,
						       filebasename(makeexpr_var(mp)))),
				 NULL);
		splist = makestmt_seq(splist, sp);
	    }
	}
	ctx2 = ctx2->ctx;
    }
    return splist;
}




void withrecordtype(tp, ex)
Type *tp;
Expr *ex;
{
    int i;
    Type *tp2;

    tp2 = tp;
    do {
	if (withlevel >= MAXWITHS-1)
	    error("Too many nested WITHs");
	withlevel++;
	tp2 = tp2->basetype;
    } while (tp2);
    tp2 = tp;
    i = withlevel;
    do {
	i--;
	withlist[i] = tp2;
	withexprs[i] = ex;
	tp2 = tp2->basetype;
    } while (tp2);
}


int simplewith(ex)
Expr *ex;
{
    switch (ex->kind) {
        case EK_VAR:
        case EK_CONST:
            return 1;
        case EK_DOT:
            return simplewith(ex->args[0]);
        default:
            return 0;
    }
}


int simplefor(sp, ex)
Stmt *sp;
Expr *ex;
{
    return (exprspeed(sp->exp2) <= 3 &&
            !checkexprchanged(sp->stm1, sp->exp2) &&
	    !exproccurs(sp->exp2, ex));
}



int tryfuncmacro(exp, mp)
Expr **exp;
Meaning *mp;
{
    char *name;
    Strlist *lp;
    Expr *ex = *exp, *ex2;

    ex2 = (mp) ? mp->constdefn : NULL;
    if (!ex2) {
	if (ex->kind == EK_BICALL || ex->kind == EK_NAME)
	    name = ex->val.s;
	else if (ex->kind == EK_FUNCTION)
	    name = ((Meaning *)ex->val.i)->name;
	else
	    return 0;
	lp = strlist_cifind(funcmacros, name);
	ex2 = (lp) ? (Expr *)lp->value : NULL;
    }
    if (ex2) {
        *exp = replacemacargs(copyexpr(ex2), ex);
	freeexpr(ex);
        return 1;
    }
    return 0;
}





#define addstmt(kind)   \
    *spp = sp = makestmt(kind),   \
    spp = &(sp->next)

#define newstmt(kind)   \
    addstmt(kind),   \
    steal_comments(firstserial, sp->serial, sflags & SF_FIRST),   \
    sflags &= ~SF_FIRST



Static int memberfuncwithlevel;


#define SF_FUNC    0x1
#define SF_SAVESER 0x2
#define SF_FIRST   0x4
#define SF_IF	   0x8

Static Stmt *p_stmt(slist, sflags)
Stmt *slist;
int sflags;
{
    Stmt *sbase = NULL, **spp = &sbase, **spp2, **spp3, **savespp;
    Stmt *defsp, **defsphook;
    register Stmt *sp;
    Stmt *sp2;
    long li1, li2, firstserial = 0, saveserial = 0, saveserial2;
    int i, forfixed, offset, line1, line2, toobig, isunsafe;
    Token savetok;
    char *name;
    Expr *ep, *ep2, *ep3, *forstep, *range, *swexpr, *trueswexpr;
    Type *tp;
    Meaning *mp, *tvar, *mp2, *tempmark, *tiplabel;
    Symbol *sym;
    enum exprkind ekind;
    Stmt *(*prochandler)();
    Strlist *cmt;

    tempmark = markstmttemps();
again:
    while (findlabelsym()) {
        newstmt(SK_LABEL);
        sp->exp1 = makeexpr_name(format_s(name_LABEL, curtokmeaning->name), tp_integer);
        gettok();
        wneedtok(TOK_COLON);