pexpr.c

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

			    (tp2->kind != TK_STRING ||
			     tp->kind != TK_STRING))
                            warning(format_s("Type mismatch in VAR parameter %s [295]",
                                             args->name));
                    }
		    ex->args[i] = ex2;
                }
                break;

	    default:
		intwarning("p_funcarglist",
			   format_s("Parameter type is %s [296]",
				    meaningkindname(args->kind)));
		break;
        }
	if (isconf &&   /* conformant array or string */
	    (!prevarg || prevarg->type != args->type)) {
	    while (tp->kind == TK_ARRAY && tp->structdefd) {
		if (tp2->kind == TK_SMALLARRAY) {
		    warning("Trying to pass a small-array for a conformant array [297]");
		    /* this has a chance of working... */
		    ex->args[ex->nargs-1] =
			makeexpr_addr(ex->args[ex->nargs-1]);
		} else if (tp2->kind == TK_STRING) {
		    ex->args[fakenum++] =
			makeexpr_arglong(makeexpr_long(1), integer16 == 0);
		    ex->args[fakenum++] =
			makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
					 integer16 == 0);
		    break;
	        } else if (tp2->kind != TK_ARRAY) {
		    warning("Type mismatch for conformant array [298]");
		    break;
		}
		ex->args[fakenum++] =
		    makeexpr_arglong(expr_reference(copyexpr(tp2->indextype->smin)),
				     integer16 == 0);
		ex->args[fakenum++] =
		    makeexpr_arglong(expr_reference(copyexpr(tp2->indextype->smax)),
				     integer16 == 0);
		tp = tp->basetype;
		tp2 = tp2->basetype;
	    }
	    if (tp->kind == TK_STRING && tp->structdefd) {
		ex->args[fakenum] =
		    makeexpr_arglong(strmax_func(ex->args[ex->nargs-1]),
				     integer16 == 0);
	    }
	}
	fakenum = -1;
	if (!isnonpos) {
	    prevarg = args;
	    args = args->xnext;
	    if (args) {
		if (curtok != TOK_RPAR && !wneedtok(TOK_COMMA))
		    skiptotoken2(TOK_RPAR, TOK_SEMI);
	    }
	}
    }
    if (curtok == TOK_COMMA) {
	if (ex->kind == EK_FUNCTION) {
	    name = ((Meaning *)ex->val.i)->name;
	    ex->kind = EK_BICALL;
	    ex->val.s = stralloc(name);
	} else
	    name = "function";
	warning(format_s("Too many arguments for %s [299]", name));
	while (curtok == TOK_COMMA) {
	    gettok();
	    insertarg(&ex, ex->nargs, p_expr(tp_integer));
	}
    }
    return ex;
}



Expr *replacemacargs(ex, fex)
Expr *ex, *fex;
{
    int i;
    Expr *ex2;

    for (i = 0; i < ex->nargs; i++)
        ex->args[i] = replacemacargs(ex->args[i], fex);
    if (ex->kind == EK_MACARG) {
	if (ex->val.i <= fex->nargs) {
	    ex2 = copyexpr(fex->args[ex->val.i - 1]);
	} else {
	    ex2 = makeexpr_name("<meef>", tp_integer);
	    note("FuncMacro specified more arguments than call [280]");
	}
	freeexpr(ex);
	return ex2;
    }
    return resimplify(ex);
}


Expr *p_noarglist(ex, mp, args)
Expr *ex;
Meaning *mp, *args;
{
    while (args && args->constdefn) {
	insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
	args = args->xnext;
    }
    if (args) {
	warning(format_s("Expected an argument list for %s [300]", mp->name));
	ex->kind = EK_BICALL;
	ex->val.s = stralloc(mp->name);
    }
    return ex;
}


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

    if (func->ctx && func->ctx != curctx &&func->ctx->kind == MK_FUNCTION &&
	func->ctx->varstructflag && !curctx->ctx->varstructflag) {
	for (mp = curctx->ctx; mp != func->ctx; mp = mp->ctx)
	    mp->varstructflag = 1;
    }
}


Expr *p_memcall(expr, mp)
Expr *expr;
Meaning *mp;
{
    Meaning *tvar, *mp2;
    Expr *ex;
    int firstarg = 0;

    mp2 = mp->type->fbase;
    ex = makeexpr_un(EK_SPCALL, mp->type->basetype, expr);
    if (mp2 && mp2->isreturn) {  /* pointer to buffer for return value */
	tvar = makestmttempvar(ex->val.type->basetype,
			       (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
	insertarg(&ex, 1, makeexpr_addr(makeexpr_var(tvar)));
	mp2 = mp2->xnext;
	firstarg++;
    }
    if (mp2 && curtok != TOK_LPAR) {
	ex = p_noarglist(ex, mp, mp2);
    } else if (curtok == TOK_LPAR) {
	gettok();
	ex = p_funcarglist(ex, mp2, firstarg, 0);
	skipcloseparen();
    }
    ex->val.i = 1;
    return ex;
}


Expr *p_funccall(mp)
Meaning *mp;
{
    Meaning *mp2, *tvar;
    Expr *ex, *ex2;
    int firstarg = 0;

    func_reference(mp);
    ex = makeexpr(EK_FUNCTION, 0);
    ex->val.i = (long)mp;
    ex->val.type = mp->type->basetype;
    mp2 = mp->type->fbase;
    if (mp2 && mp2->isreturn) {    /* pointer to buffer for return value */
        tvar = makestmttempvar(ex->val.type->basetype,
            (ex->val.type->basetype->kind == TK_STRING) ? name_STRING : name_TEMP);
        insertarg(&ex, 0, makeexpr_addr(makeexpr_var(tvar)));
        mp2 = mp2->xnext;
	firstarg++;
    }
    if (mp2 && curtok != TOK_LPAR) {
	ex = p_noarglist(ex, mp, mp2);
    } else if (curtok == TOK_LPAR) {
	gettok();
        ex = p_funcarglist(ex, mp2, firstarg, (mp->constdefn != NULL));
        skipcloseparen();
    }
    if (mp->constdefn) {
        ex2 = replacemacargs(copyexpr(mp->constdefn), ex);
	ex2 = gentle_cast(ex2, ex->val.type);
	ex2->val.type = ex->val.type;
        freeexpr(ex);
        return ex2;
    }
    return ex;
}






Expr *accumulate_strlit()
{
    char buf[256], ch, *cp, *cp2;
    int len, i, danger = 0;

    len = 0;
    cp = buf;
    for (;;) {
        if (curtok == TOK_STRLIT) {
            cp2 = curtokbuf;
            i = curtokint;
            while (--i >= 0) {
                if (++len <= 255) {
                    ch = *cp++ = *cp2++;
                    if (ch & 128)
                        danger++;
                }
            }
        } else if (curtok == TOK_HAT) {    /* Turbo */
            i = getchartok() & 0x1f;
            if (++len <= 255)
                *cp++ = i;
	} else if (curtok == TOK_LPAR) {   /* VAX */
	    Value val;
	    do {
		gettok();
		val = p_constant(tp_integer);
		if (++len <= 255)
		    *cp++ = val.i;
	    } while (curtok == TOK_COMMA);
	    skipcloseparen();
	    continue;
        } else
            break;
        gettok();
    }
    if (len > 255) {
        warning("String literal too long [301]");
        len = 255;
    }
    if (danger &&
        !(unsignedchar == 1 ||
          (unsignedchar != 0 && signedchars == 0)))
        note(format_s("Character%s >= 128 encountered [281]", (danger > 1) ? "s" : ""));
    return makeexpr_lstring(buf, len);
}



Expr *pascaltypecast(type, ex2)
Type *type;
Expr *ex2;
{
    if (type->kind == TK_POINTER || type->kind == TK_STRING ||
	type->kind == TK_ARRAY)
	ex2 = makeexpr_stringcast(ex2);
    else
	ex2 = makeexpr_charcast(ex2);
    if ((ex2->val.type->kind == TK_INTEGER ||
	 ex2->val.type->kind == TK_CHAR ||
	 ex2->val.type->kind == TK_BOOLEAN ||
	 ex2->val.type->kind == TK_ENUM ||
	 ex2->val.type->kind == TK_SUBR ||
	 ex2->val.type->kind == TK_REAL ||
	 ex2->val.type->kind == TK_POINTER ||
	 ex2->val.type->kind == TK_STRING) &&
	(type->kind == TK_INTEGER ||
	 type->kind == TK_CHAR ||
	 type->kind == TK_BOOLEAN ||
	 type->kind == TK_ENUM ||
	 type->kind == TK_SUBR ||
	 type->kind == TK_REAL ||
	 type->kind == TK_POINTER)) {
	if (type->kind == TK_POINTER || ex2->val.type->kind == TK_POINTER)
	    return makeexpr_un(EK_CAST, type, ex2);
	else
	    return makeexpr_un(EK_ACTCAST, type, ex2);
    } else {
	return makeexpr_hat(makeexpr_cast(makeexpr_addr(ex2),
					  makepointertype(type)), 0);
    }
}




Static Expr *p_factor(target)
Type *target;
{
    Expr *ex, *ex2;
    Type *type;
    Meaning *mp, *mp2;

    switch (curtok) {

        case TOK_INTLIT:
            ex = makeexpr_long(curtokint);
            gettok();
            return ex;

        case TOK_HEXLIT:
            ex = makeexpr_long(curtokint);
            insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
            gettok();
            return ex;

        case TOK_OCTLIT:
            ex = makeexpr_long(curtokint);
            insertarg(&ex, 0, makeexpr_name("%#lo", tp_integer));
            gettok();
            return ex;

        case TOK_MININT:
	    strcat(curtokbuf, ".0");

	/* fall through */
        case TOK_REALLIT:
            ex = makeexpr_real(curtokbuf);
            gettok();
            return ex;

        case TOK_HAT:
        case TOK_STRLIT:
            ex = accumulate_strlit();
            return ex;

        case TOK_LPAR:
            gettok();
            ex = p_expr(target);
            skipcloseparen();
            return dots_n_hats(ex, target);

        case TOK_NOT:
	case TOK_TWIDDLE:
            gettok();
            ex = p_factor(tp_integer);
            if (ord_type(ex->val.type)->kind == TK_INTEGER)
                return makeexpr_un(EK_BNOT, tp_integer, ex);
            else
                return makeexpr_not(ex);

	case TOK_MINUS:
	    gettok();
            if (curtok == TOK_MININT) {
                gettok();
                return makeexpr_long(MININT);
            } else
		return makeexpr_neg(p_factor(target));
	    
        case TOK_PLUS:
	    gettok();
	    return p_factor(target);

        case TOK_ADDR:
            gettok();
	    if (curtok == TOK_ADDR) {
		gettok();
		ex = p_factor(tp_proc);
		if (ex->val.type->kind == TK_PROCPTR && ex->kind == EK_COMMA)
		    return grabarg(grabarg(grabarg(ex, 0), 1), 0);
		if (ex->val.type->kind != TK_CPROCPTR)
		    warning("@@ allowed only for procedure pointers [302]");
		return makeexpr_addrf(ex);
	    }
            if (curtok == TOK_IDENT && 0 &&  /***/
                curtokmeaning && (curtokmeaning->kind == MK_FUNCTION ||
                                  curtokmeaning->kind == MK_SPECIAL)) {
                if (curtokmeaning->ctx == nullctx)
                    warning(format_s("Can't take address of predefined object %s [303]",
                                     curtokmeaning->name));
                ex = makeexpr_name(curtokmeaning->name, tp_anyptr);
                gettok();
            } else {
		ex = p_factor(tp_proc);
		if (ex->val.type->kind == TK_PROCPTR) {
		  /*  ex = makeexpr_dotq(ex, "proc", tp_anyptr);  */
		} else if (ex->val.type->kind == TK_CPROCPTR) {
		    ex = makeexpr_cast(ex, tp_anyptr);
		} else
		    ex = makeexpr_addrf(ex);
            }
            return ex;

        case TOK_LBR:
	case TOK_LBRACE:
            return p_setfactor(target && target->kind == TK_SET
			       ? target->indextype : NULL, 0);

        case TOK_NIL:
            gettok();
            return makeexpr_nil();

	case TOK_IF:    /* nifty Pascal extension */
	    gettok();
	    ex = p_expr(tp_boolean);
	    wneedtok(TOK_THEN);
	    ex2 = p_expr(tp_integer);
	    if (wneedtok(TOK_ELSE))
		return makeexpr_cond(ex, ex2, p_factor(ex2->val.type));
	    else
		return makeexpr_cond(ex, ex2, makeexpr_long(0));

	case TOK_INHERITED:
	    gettok();
	    if (!wexpecttok(TOK_IDENT))
		skiptotoken(TOK_IDENT);
	    type = curtokmeaning->rectype;
	    if (type) type = type->basetype;
	    while (type) {
		mp2 = curtoksym->fbase;
		while (mp2 && mp2->rectype != type)
		    mp2 = mp2->snext;
		if (mp2)
		    break;
		type = type->basetype;
	    }
	    if (type) {
		if (mp2->kind == MK_FUNCTION)
		    ex = makeexpr_var(mp2->xnext);
		else
		    ex = makeexpr_name(format_ss("%s::%s",
						 type->meaning->name,
						 mp2->name),
				       mp2->type);
	    } else {
		warning(format_s("No field called %s in that object [332]",
				 curtokbuf));
		return p_variable(target);
	    }
	    gettok();
	    return dots_n_hats(ex, target);

        case TOK_IDENT:
            mp = curtokmeaning;
	    if (mp == mp_new_normal)
		mp = curtokmeaning = mp_new_turbo;
            switch ((mp) ? mp->kind : MK_VAR) {

                case MK_TYPE: