pexpr.c

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

		    gettok();
                    type = mp->type;
                    switch (curtok) {

                        case TOK_LPAR:    /* Turbo type cast */
                            gettok();
			    if (type->kind == TK_RECORD && type->issigned &&
				!turboobjects)
				type = makepointertype(type);
                            ex2 = p_expr(type);
			    ex = pascaltypecast(type, ex2);
                            skipcloseparen();
                            return dots_n_hats(ex, target);

                        case TOK_LBR:
			case TOK_LBRACE:
                            switch (type->kind) {

                                case TK_SET:
                                case TK_SMALLSET:
                                    return p_setfactor(type->indextype, 1);

                                case TK_RECORD:
                                    return p_constrecord(type, 0);

                                case TK_ARRAY:
                                case TK_SMALLARRAY:
                                    return p_constarray(type, 0);

                                case TK_STRING:
                                    return p_conststring(type, 0);

                                default:
                                    warning("Bad type for constructor [304]");
				    skipparens();
				    return makeexpr_name(mp->name, mp->type);
                            }

			case TOK_DOT:
			    gettok();
			    if (!wexpecttok(TOK_IDENT))
				skiptotoken(TOK_IDENT);
			    if (type->kind == TK_RECORD) {
				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);
			    } else {
				warning(format_s("%s is not an object type",
						 type->meaning->name));
				return p_variable(target);
			    }

			default:
			    wexpected("an expression");
			    return makeexpr_name(mp->name, mp->type);
                    }

                case MK_SPECIAL:
                    if (mp->handler && mp->isfunction &&
			(peeknextchar() == '(' ||
			 !target || mp == mp_self_func ||
			 (target->kind != TK_PROCPTR &&
			  target->kind != TK_CPROCPTR))) {
                        gettok();
                        if ((mp->sym->flags & LEAVEALONE) || mp->constdefn) {
                            ex = makeexpr_bicall_0(mp->name, tp_integer);
                            if (curtok == TOK_LPAR) {
                                do {
                                    gettok();
                                    insertarg(&ex, ex->nargs, p_expr(NULL));
                                } while (curtok == TOK_COMMA);
                                skipcloseparen();
                            }
                            tryfuncmacro(&ex, mp);
			    return ex;
                        }
                        ex = (*mp->handler)(mp);
			if (!ex)
			    ex = makeexpr_long(0);
			return dots_n_hats(ex, target);
                    } else {
			if (target &&
			    (target->kind == TK_PROCPTR ||
			     target->kind == TK_CPROCPTR))
			    note("Using a built-in procedure as a procedure pointer [316]");
                        else
			    symclass(curtoksym);
                        gettok();
                        return makeexpr_name(mp->name, tp_integer);
                    }

                case MK_FUNCTION:
                    mp->refcount++;
		    if (mp->rectype)
			return p_variable(target);
                    need_forward_decl(mp);
		    gettok();
                    if (mp->isfunction &&
			(curtok == TOK_LPAR || !target ||
			 (target->kind != TK_PROCPTR &&
			  target->kind != TK_CPROCPTR))) {
                        ex = p_funccall(mp);
                        if (!mp->constdefn) {
                            if (mp->handler && !(mp->sym->flags & LEAVEALONE))
                                ex = (*mp->handler)(ex);
			}
			if (mp->cbase->kind == MK_VARPARAM) {
			    ex = makeexpr_hat(ex, 0);    /* returns pointer to structured result */
                        }
                        return dots_n_hats(ex, target);
                    } else {
			if (mp->handler && !(mp->sym->flags & LEAVEALONE))
			    note("Using a built-in procedure as a procedure pointer [316]");
			if (target && target->kind == TK_CPROCPTR) {
			    type = maketype(TK_CPROCPTR);
			    type->basetype = mp->type;
			    type->escale = 0;
			    mp2 = makestmttempvar(type, name_TEMP);
			    ex = makeexpr_comma(
                                    makeexpr_assign(
                                       makeexpr_var(mp2),
				       makeexpr_name(mp->name, tp_text)),
				    makeexpr_var(mp2));
			    if (mp->ctx->kind == MK_FUNCTION)
				warning("Procedure pointer to nested procedure [305]");
			} else {
			    type = maketype(TK_PROCPTR);
			    type->basetype = mp->type;
			    type->escale = 1;
			    mp2 = makestmttempvar(type, name_TEMP);
			    ex = makeexpr_comma(
                                    makeexpr_comma(
                                       makeexpr_assign(
                                          makeexpr_dotq(makeexpr_var(mp2),
							"proc",
							tp_anyptr),
					  makeexpr_name(mp->name, tp_text)),
                                          /* handy pointer type */
				       makeexpr_assign(
                                          makeexpr_dotq(makeexpr_var(mp2),
							"link",
							tp_anyptr),
				          makeexpr_ctx(mp->ctx))),
				    makeexpr_var(mp2));
			}
                        return ex;
                    }

                default:
                    return p_variable(target);
            }

	default:
	    wexpected("an expression");
	    return makeexpr_long(0);
	    
    }
}




Static Expr *p_powterm(target)
Type *target;
{
    Expr *ex = p_factor(target);
    Expr *ex2;
    int i, castit;
    long v;

    if (curtok == TOK_STARSTAR) {
	gettok();
	ex2 = p_powterm(target);
	if (ex->val.type->kind == TK_REAL ||
	    ex2->val.type->kind == TK_REAL) {
	    if (checkconst(ex2, 2)) {
		ex = makeexpr_sqr(ex, 0);
	    } else if (checkconst(ex2, 3)) {
		ex = makeexpr_sqr(ex, 1);
	    } else {
		castit = castargs >= 0 ? castargs : (prototypes == 0);
		if (ex->val.type->kind != TK_REAL && castit)
		    ex = makeexpr_cast(ex, tp_longreal);
		if (ex2->val.type->kind != TK_REAL && castit)
		    ex2 = makeexpr_cast(ex2, tp_longreal);
		ex = makeexpr_bicall_2("pow", tp_longreal, ex, ex2);
	    }
	} else if (checkconst(ex, 2)) {
	    freeexpr(ex);
	    ex = makeexpr_bin(EK_LSH, tp_integer,
			      makeexpr_longcast(makeexpr_long(1), 1), ex2);
	} else if (checkconst(ex, 0) ||
		   checkconst(ex, 1) ||
		   checkconst(ex2, 1)) {
	    freeexpr(ex2);
	} else if (checkconst(ex2, 0)) {
	    freeexpr(ex);
	    freeexpr(ex2);
	    ex = makeexpr_long(1);
	} else if (isliteralconst(ex, NULL) == 2 &&
		   isliteralconst(ex2, NULL) == 2 &&
		   ex2->val.i > 0) {
	    v = ex->val.i;
	    i = ex2->val.i;
	    while (--i > 0)
		v *= ex->val.i;
	    freeexpr(ex);
	    freeexpr(ex2);
	    ex = makeexpr_long(v);
	} else if (checkconst(ex2, 2)) {
	    ex = makeexpr_sqr(ex, 0);
	} else if (checkconst(ex2, 3)) {
	    ex = makeexpr_sqr(ex, 1);
	} else {
	    ex = makeexpr_bicall_2("ipow", tp_integer,
				   makeexpr_arglong(ex, 1),
				   makeexpr_arglong(ex2, 1));
	}
    }
    return ex;
}


Static Expr *p_term(target)
Type *target;
{
    Expr *ex = p_powterm(target);
    Expr *ex2;
    Type *type;
    Meaning *tvar;
    int useshort;

    for (;;) {
	checkkeyword(TOK_SHL);
	checkkeyword(TOK_SHR);
	checkkeyword(TOK_REM);
        switch (curtok) {

            case TOK_STAR:
                gettok();
                if (ex->val.type->kind == TK_SET ||
                    ex->val.type->kind == TK_SMALLSET) {
                    ex2 = p_powterm(ex->val.type);
                    type = mixsets(&ex, &ex2);
                    if (type->kind == TK_SMALLSET) {
                        ex = makeexpr_bin(EK_BAND, type, ex, ex2);
                    } else {
                        tvar = makestmttempvar(type, name_SET);
                        ex = makeexpr_bicall_3(setintname, type,
                                               makeexpr_var(tvar),
                                               ex, ex2);
                    }
                } else
                    ex = makeexpr_times(ex, p_powterm(tp_integer));
                break;

            case TOK_SLASH:
                gettok();
                if (ex->val.type->kind == TK_SET ||
                    ex->val.type->kind == TK_SMALLSET) {
                    ex2 = p_powterm(ex->val.type);
                    type = mixsets(&ex, &ex2);
                    if (type->kind == TK_SMALLSET) {
                        ex = makeexpr_bin(EK_BXOR, type, ex, ex2);
                    } else {
                        tvar = makestmttempvar(type, name_SET);
                        ex = makeexpr_bicall_3(setxorname, type,
                                               makeexpr_var(tvar),
                                               ex, ex2);
                    }
		} else
		    ex = makeexpr_divide(ex, p_powterm(tp_integer));
                break;

            case TOK_DIV:
                gettok();
                ex = makeexpr_div(ex, p_powterm(tp_integer));
                break;

            case TOK_REM:
                gettok();
                ex = makeexpr_rem(ex, p_powterm(tp_integer));
                break;

            case TOK_MOD:
                gettok();
                ex = makeexpr_mod(ex, p_powterm(tp_integer));
                break;

            case TOK_AND:
	    case TOK_AMP:
		if (lowpreclogicals || peeknextword("THEN"))
		    return ex;
		useshort = (curtok == TOK_AMP);
                gettok();
                ex2 = p_powterm(tp_integer);
                if (ord_type(ex->val.type)->kind == TK_INTEGER)
                    ex = makeexpr_bin(EK_BAND, ex->val.type, ex, ex2);
                else if (partial_eval_flag || useshort ||
                         (shortopt && nosideeffects(ex2, 1)))
                    ex = makeexpr_and(ex, ex2);
                else
                    ex = makeexpr_bin(EK_BAND, tp_boolean, ex, ex2);
                break;

            case TOK_SHL:
                gettok();
                ex = makeexpr_bin(EK_LSH, ex->val.type, ex, p_powterm(tp_integer));
                break;

            case TOK_SHR:
                gettok();
                ex = force_unsigned(ex);
                ex = makeexpr_bin(EK_RSH, ex->val.type, ex, p_powterm(tp_integer));
                break;

            default:
                return ex;
        }
    }
}



Expr *p_sexpr(target)
Type *target;
{
    Expr *ex, *ex2;
    Type *type;
    Meaning *tvar;
    int useshort;

    switch (curtok) {
        case TOK_MINUS:
            gettok();
            if (curtok == TOK_MININT) {
                gettok();
                ex = makeexpr_long(MININT);
		break;
            }
            ex = makeexpr_neg(p_term(target));
            break;
        case TOK_PLUS:
            gettok();
        /* fall through */
        default:
            ex = p_term(target);
            break;
    }
    if (curtok == TOK_PLUS &&
        (ex->val.type->kind == TK_STRING ||
         ord_type(ex->val.type)->kind == TK_CHAR ||
         ex->val.type->kind == TK_ARRAY)) {
        while (curtok == TOK_PLUS) {
            gettok();
            ex = makeexpr_concat(ex, p_term(NULL), 0);
        }
        return ex;
    } else {
        for (;;) {
	    checkkeyword(TOK_XOR);
            switch (curtok) {

                case TOK_PLUS:
                    gettok();
                    if (ex->val.type->kind == TK_SET ||
                        ex->val.type->kind == TK_SMALLSET) {
                        ex2 = p_term(ex->val.type);
                        type = mixsets(&ex, &ex2);
                        if (type->kind == TK_SMALLSET) {
                            ex = makeexpr_bin(EK_BOR, type, ex, ex2);
                        } else {
                            tvar = makestmttempvar(type, name_SET);
                            ex = makeexpr_bicall_3(setunionname, type,
                                                   makeexpr_var(tvar),
                                                   ex, ex2);
                        }
                    } else
                        ex = makeexpr_plus(ex, p_term(tp_integer));
                    break;

                case TOK_MINUS:
                    gettok();
                    if (ex->val.type->kind == TK_SET ||
                        ex->val.type->kind == TK_SMALLSET) {
                        ex2 = p_term(tp_integer);
                        type = mixsets(&ex, &ex2);
                        if (type->kind == TK_SMALLSET) {
                            ex = makeexpr_bin(EK_BAND, type, ex,
                                              makeexpr_un(EK_BNOT, type, ex2));
                        } else {
                            tvar = makestmttempvar(type, name_SET);
                            ex = makeexpr_bicall_3(setdiffname, type,
                                                   makeexpr_var(tvar), ex, ex2);
                        }
                    } else
                        ex = makeexpr_minus(ex, p_term(tp_integer));
                    break;

		case TOK_VBAR:
		    if (modula2)
			return ex;
		    /* fall through */

                case TOK_OR:
		    if (lowpreclogicals || peeknextword("ELSE"))
			return ex;
		    useshort = (curtok == TOK_VBAR);
                    gettok();
                    ex2 = p_term(tp_integer);
                    if (ord_type(ex->val.type)->kind == TK_INTEGER)
                        ex = makeexpr_bin(EK_BOR, ex->val.type, ex, ex2);
                    else if (partial_eval_flag || useshort ||
                             (shortopt && nosideeffects(ex2, 1)))
                        ex = makeexpr_or(ex, ex2);
                    else
                        ex = makeexpr_bin(EK_BOR, tp_boolean, ex, ex2);
                    break;