pexpr.c

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

	if (mp->varstructflag && mp->isref) {
	    ex = makeexpr_var(mp);
	    ex->val.type = makepointertype(ex->val.type);
	    ex = makeexpr_hat(ex, 0);
	} else
	    ex = makeexpr_var(mp);
    } else {
        symclass(mp->sym);
        ex = makeexpr_name(mp->name, tp_integer);
    }
    gettok();
    return dots_n_hats(ex, target);
}




Expr *p_ord_expr()
{
    return makeexpr_charcast(p_expr(tp_integer));
}



Static Expr *makesmallsetconst(bits, type)
long bits;
Type *type;
{
    Expr *ex;

    ex = makeexpr_long(bits);
    ex->val.type = type;
    if (smallsetconst != 2)
        insertarg(&ex, 0, makeexpr_name("%#lx", tp_integer));
    return ex;
}



Expr *packset(ex, type)
Expr *ex;
Type *type;
{
    Meaning *mp;
    Expr *ex2;
    long max2;

    if (ex->kind == EK_BICALL) {
        if (!strcmp(ex->val.s, setexpandname) &&
            (mp = istempvar(ex->args[0])) != NULL) {
            canceltempvar(mp);
            return grabarg(ex, 1);
        }
        if (!strcmp(ex->val.s, setunionname) &&
            (mp = istempvar(ex->args[0])) != NULL &&
            !exproccurs(ex->args[1], ex->args[0]) &&
            !exproccurs(ex->args[2], ex->args[0])) {
            canceltempvar(mp);
            return makeexpr_bin(EK_BOR, type, packset(ex->args[1], type),
                                              packset(ex->args[2], type));
        }
        if (!strcmp(ex->val.s, setaddname)) {
            ex2 = makeexpr_bin(EK_LSH, type,
                               makeexpr_longcast(makeexpr_long(1), 1),
                               ex->args[1]);
            ex = packset(ex->args[0], type);
            if (checkconst(ex, 0))
                return ex2;
            else
                return makeexpr_bin(EK_BOR, type, ex, ex2);
        }
        if (!strcmp(ex->val.s, setaddrangename)) {
            if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
                note("Range construction was implemented by a subtraction which may overflow [278]");
            ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
                                              makeexpr_longcast(makeexpr_long(1), 1),
                                              makeexpr_plus(ex->args[2],
                                                            makeexpr_long(1))),
                                 makeexpr_bin(EK_LSH, type,
                                              makeexpr_longcast(makeexpr_long(1), 1),
                                              ex->args[1]));
            ex = packset(ex->args[0], type);
            if (checkconst(ex, 0))
                return ex2;
            else
                return makeexpr_bin(EK_BOR, type, ex, ex2);
        }
    }
    return makeexpr_bicall_1(setpackname, type, ex);
}



#define MAXSETLIT 400

Expr *p_setfactor(target, sure)
Type *target;
int sure;
{
    Expr *ex, *exmax = NULL, *ex2;
    Expr *first[MAXSETLIT], *last[MAXSETLIT];
    char doneflag[MAXSETLIT];
    int i, j, num, donecount;
    int isconst, guesstype;
    long maxv, max2;
    Value val;
    Type *tp, *type;
    Meaning *tvar;

    if (curtok == TOK_LBRACE)
	gettok();
    else if (!wneedtok(TOK_LBR))
	return makeexpr_long(0);
    if (curtok == TOK_RBR || curtok == TOK_RBRACE) {        /* empty set */
        gettok();
        val.type = tp_smallset;
        val.i = 0;
        val.s = NULL;
        return makeexpr_val(val);
    }
    type = target;
    guesstype = !sure;
    maxv = -1;
    isconst = 1;
    num = 0;
    for (;;) {
        if (num >= MAXSETLIT) {
            warning(format_d("Too many elements in set literal; max=%d [290]", MAXSETLIT));
            ex = p_expr(type);
            while (curtok != TOK_RBR && curtok != TOK_RBRACE) {
                gettok();
                ex = p_expr(type);
            }
            break;
        }
        if (guesstype && num == 0) {
            ex = p_ord_expr();
	    type = ex->val.type;
        } else {
            ex = p_expr(type);
        }
        first[num] = ex = gentle_cast(ex, type);
        doneflag[num] = 0;
        if (curtok == TOK_DOTS || curtok == TOK_COLON) {   /* UCSD? */
            val = eval_expr(ex);
            if (val.type) {
		if (val.i > maxv) {     /* In case of [127..0] */
		    maxv = val.i;
		    exmax = ex;
		}
	    } else
                isconst = 0;
            gettok();
            last[num] = ex = gentle_cast(p_expr(type), type);
        } else {
            last[num] = NULL;
        }
        val = eval_expr(ex);
        if (val.type) {
            if (val.i > maxv) {
                maxv = val.i;
                exmax = ex;
            }
        } else {
            isconst = 0;
            maxv = LONG_MAX;
        }
        num++;
        if (curtok == TOK_COMMA)
            gettok();
        else
            break;
    }
    if (curtok == TOK_RBRACE)
	gettok();
    else if (!wneedtok(TOK_RBR))
	skippasttotoken(TOK_RBR, TOK_SEMI);
    tp = first[0]->val.type;
    if (guesstype) {      /* must determine type */
        if (maxv == LONG_MAX) {
	    if (target && ord_range(target, NULL, &max2))
		maxv = max2;
            else if (ord_range(tp, NULL, &max2) && max2 < 1000000 &&
		     (max2 >= defaultsetsize || num == 1))
                maxv = max2;
	    else
		maxv = defaultsetsize-1;
            exmax = makeexpr_long(maxv);
        } else
            exmax = copyexpr(exmax);
        if (!ord_range(tp, NULL, &max2) || maxv != max2)
            tp = makesubrangetype(tp, makeexpr_long(0), exmax);
        type = makesettype(tp);
    } else
	type = makesettype(type);
    donecount = 0;
    if (smallsetconst > 0) {
        val.i = 0;
        for (i = 0; i < num; i++) {
            if (first[i]->kind == EK_CONST && first[i]->val.i < setbits &&
                (!last[i] || (last[i]->kind == EK_CONST &&
                              last[i]->val.i >= 0 &&
                              last[i]->val.i < setbits))) {
                if (last[i]) {
                    for (j = first[i]->val.i; j <= last[i]->val.i; j++)
                        val.i |= 1L << j;
                } else
		    val.i |= 1L << first[i]->val.i;
                doneflag[i] = 1;
                donecount++;
            }
        }
    }
    if (donecount) {
        ex = makesmallsetconst(val.i, tp_smallset);
    } else
        ex = NULL;
    if (type->kind == TK_SMALLSET) {
        for (i = 0; i < num; i++) {
            if (!doneflag[i]) {
                ex2 = makeexpr_bin(EK_LSH, type,
				   makeexpr_longcast(makeexpr_long(1), 1),
				   enum_to_int(first[i]));
                if (last[i]) {
                    if (ord_range(type->indextype, NULL, &max2) && max2 == setbits-1)
                        note("Range construction was implemented by a subtraction which may overflow [278]");
                    ex2 = makeexpr_minus(makeexpr_bin(EK_LSH, type,
                                                      makeexpr_longcast(makeexpr_long(1), 1),
                                                      makeexpr_plus(enum_to_int(last[i]),
                                                                    makeexpr_long(1))),
                                         ex2);
                }
                if (ex)
                    ex = makeexpr_bin(EK_BOR, type, makeexpr_longcast(ex, 1), ex2);
                else
                    ex = ex2;
            }
        }
    } else {
        tvar = makestmttempvar(type, name_SET);
        if (!ex) {
            val.type = tp_smallset;
	    val.i = 0;
	    val.s = NULL;
	    ex = makeexpr_val(val);
	}
        ex = makeexpr_bicall_2(setexpandname, type,
                               makeexpr_var(tvar), makeexpr_arglong(ex, 1));
        for (i = 0; i < num; i++) {
            if (!doneflag[i]) {
                if (last[i])
                    ex = makeexpr_bicall_3(setaddrangename, type,
                                           ex, makeexpr_arglong(enum_to_int(first[i]), 0),
                                               makeexpr_arglong(enum_to_int(last[i]), 0));
                else
                    ex = makeexpr_bicall_2(setaddname, type,
                                           ex, makeexpr_arglong(enum_to_int(first[i]), 0));
            }
        }
    }
    return ex;
}




Expr *p_funcarglist(ex, args, firstarg, ismacro)
Expr *ex;
Meaning *args;
int firstarg, ismacro;
{
    Meaning *mp, *mp2, *arglist = args, *prevarg = NULL;
    Expr *ex2;
    int i, fi, fakenum = -1, castit, isconf, isnonpos = 0;
    Type *tp, *tp2;
    char *name;

    castit = castargs;
    if (castit < 0)
	castit = (prototypes == 0);
    while (args) {
	if (isnonpos) {
	    while (curtok == TOK_COMMA)
		gettok();
	    if (curtok == TOK_RPAR) {
		args = arglist;
		i = firstarg;
		while (args) {
		    if (ex->nargs <= i)
			insertarg(&ex, ex->nargs, NULL);
		    if (!ex->args[i]) {
			if (args->constdefn)
			    ex->args[i] = copyexpr(args->constdefn);
			else {
			    warning(format_s("Missing value for parameter %s [291]",
					     args->name));
			    ex->args[i] = makeexpr_long(0);
			}
		    }
		    args = args->xnext;
		    i++;
		}
		break;
	    }
	}
	if (args->isreturn || args->fakeparam) {
	    if (args->fakeparam) {
		if (fakenum < 0)
		    fakenum = ex->nargs;
		if (args->constdefn)
		    insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
		else
		    insertarg(&ex, ex->nargs, makeexpr_long(0));
	    }
	    args = args->xnext;     /* return value parameter */
	    continue;
	}
	if (curtok == TOK_RPAR) {
	    if (args->constdefn) {
		insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
		args = args->xnext;
		continue;
	    } else {
		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 few arguments for %s [292]", name));
		return ex;
	    }
	}
	if (curtok == TOK_COMMA) {
	    if (args->constdefn)
		insertarg(&ex, ex->nargs, copyexpr(args->constdefn));
	    else {
		warning(format_s("Missing parameter %s [293]", args->name));
		insertarg(&ex, ex->nargs, makeexpr_long(0));
	    }
	    gettok();
	    args = args->xnext;
	    continue;
	}
	p_mech_spec(0);
	if (curtok == TOK_IDENT) {
	    mp = arglist;
	    mp2 = NULL;
	    i = firstarg;
	    fi = -1;
	    while (mp && strcmp(curtokbuf, mp->sym->name)) {
		if (mp->fakeparam) {
		    if (fi < 0)
			fi = i;
		} else
		    fi = -1;
		i++;
		mp2 = mp;
		mp = mp->xnext;
	    }
	    if (mp &&
		(peeknextchar() == 1 || !curtokmeaning || isnonpos)) {
		gettok();
		wneedtok(TOK_ASSIGN);
		prevarg = mp2;
		args = mp;
		fakenum = fi;
		isnonpos = 1;
	    } else
		i = ex->nargs;
	} else
	    i = ex->nargs;
	while (ex->nargs <= i)
	    insertarg(&ex, ex->nargs, NULL);
	if (ex->args[i])
	    warning(format_s("Multiple values for parameter %s [294]",
			     args->name));
	tp = args->type;
	ex2 = p_expr(tp);
	if (args->kind == MK_VARPARAM)
	    tp = tp->basetype;
	if (isfiletype(tp, 1) && is_std_file(ex2)) {
	    mp2 = makestmttempvar(tp_bigtext, name_TEMP);
	    ex2 = makeexpr_comma(
		   makeexpr_comma(makeexpr_assign(filebasename(makeexpr_var(mp2)),
						  ex2),
				  makeexpr_assign(filenamepart(makeexpr_var(mp2)),
						  makeexpr_string(""))),
				 makeexpr_var(mp2));
	}
	tp2 = ex2->val.type;
	isconf = ((tp->kind == TK_ARRAY ||
		   tp->kind == TK_STRING) && tp->structdefd);
        switch (args->kind) {

            case MK_PARAM:
	        if (args->isref) {
		    if (tp2 != tp && !isconf &&
			(tp2->kind != TK_STRING ||
			 tp->kind != TK_STRING))
			warning(format_s("Type mismatch in VAR parameter %s [295]",
					 args->name));
		} else if (castit && tp->kind == TK_REAL &&
		    ex2->val.type->kind != TK_REAL)
                    ex2 = makeexpr_cast(ex2, tp);
                else if (ord_type(tp)->kind == TK_INTEGER && !ismacro)
                    ex2 = makeexpr_arglong(ex2, long_type(tp));
                else if (args->othername && args->rectype != tp &&
                         tp->kind != TK_STRING && args->type == tp2)
                    ex2 = makeexpr_addr(ex2);
                else
                    ex2 = gentle_cast(ex2, tp);
		ex->args[i] = ex2;
                break;

            case MK_VARPARAM:
                if (args->type == tp_strptr && args->anyvarflag) {
		    ex->args[i] = strmax_func(ex2);
                    insertarg(&ex, ex->nargs-1, makeexpr_addr(ex2));
		    if (isnonpos)
			note("Non-positional conformant parameters may not work [279]");
                } else {                        /* regular VAR parameter */
		    if (!expr_is_lvalue(ex2) ||
			(tp->kind == TK_REAL &&
			 ord_type(tp2)->kind == TK_INTEGER)) {
			mp2 = makestmttempvar(tp, name_TEMP);
			ex2 = makeexpr_comma(makeexpr_assign(makeexpr_var(mp2),
							     ex2),
					     makeexpr_addrf(makeexpr_var(mp2)));
		    } else
			ex2 = makeexpr_addrf(ex2);
                    if (args->anyvarflag ||
                        (tp->kind == TK_POINTER && tp2->kind == TK_POINTER &&
                         (tp == tp_anyptr || tp2 == tp_anyptr))) {
			if (!ismacro)
			    ex2 = makeexpr_cast(ex2, args->type);
                    } else {
                        if (tp2 != tp && !isconf &&