citmods.c

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

                                     ex1,
                                     makeexpr_bin(EK_LSH, tp_integer,
                                                  makeexpr_longcast(makeexpr_long(1), longness),
                                                  makeexpr_unlongcast(ex->args[0]))),
                        makeexpr_long(0));
}



Static Stmt *proc_na_set(ex)
Expr *ex;
{
    Stmt *sp;
    Expr *vex;
    Meaning *tvar;

    if (!check0_31(ex->args[0]))
        return makestmt_call(ex);
    if (!nosideeffects(ex->args[1], 1)) {
        tvar = makestmttempvar(ex->args[1]->val.type, name_TEMP);
        sp = makestmt_assign(makeexpr_var(tvar), ex->args[1]);
        vex = makeexpr_hat(makeexpr_var(tvar), 0);
    } else {
        sp = NULL;
        vex = makeexpr_hat(ex->args[1], 0);
    }
    sp = makestmt_seq(sp,
                      makestmt_assign(vex,
                                      makeexpr_bin(EK_BOR, tp_integer,
                                                   copyexpr(vex),
                                                   makeexpr_bin(EK_LSH, tp_integer,
                                                                makeexpr_longcast(makeexpr_long(1), 1),
                                                                makeexpr_unlongcast(ex->args[0])))));
    return sp;
}



Static Stmt *proc_na_clear(ex)
Expr *ex;
{
    Stmt *sp;
    Expr *vex;
    Meaning *tvar;

    if (!check0_31(ex->args[0]))
        return makestmt_call(ex);
    if (!nosideeffects(ex->args[1], 1)) {
        tvar = makestmttempvar(ex->args[1]->val.type, name_TEMP);
        sp = makestmt_assign(makeexpr_var(tvar), ex->args[1]);
        vex = makeexpr_hat(makeexpr_var(tvar), 0);
    } else {
        sp = NULL;
        vex = makeexpr_hat(ex->args[1], 0);
    }
    sp = makestmt_seq(sp,
                      makestmt_assign(vex,
                                      makeexpr_bin(EK_BAND, tp_integer,
                                                   copyexpr(vex),
                                                   makeexpr_un(EK_BNOT, tp_integer,
                                                       makeexpr_bin(EK_LSH, tp_integer,
                                                                    makeexpr_longcast(makeexpr_long(1), 1),
                                                                    makeexpr_unlongcast(ex->args[0]))))));
    return sp;
}



Static Expr *func_na_po2(ex)
Expr *ex;
{
    if (!check0_31(ex->args[0]))
        return ex;
    return makeexpr_bin(EK_LSH, tp_integer,
                        makeexpr_longcast(makeexpr_long(1), 1),
                        makeexpr_unlongcast(grabarg(ex, 0)));
}



Static Expr *func_na_lobits(ex)
Expr *ex;
{
    if (!check0_31(ex->args[0]))
        return ex;
    return makeexpr_un(EK_BNOT, tp_integer,
                       makeexpr_bin(EK_LSH, tp_integer,
                                    makeexpr_longcast(makeexpr_long(-1), 1),
                                    makeexpr_unlongcast(grabarg(ex, 0))));
}



Static Expr *func_na_hibits(ex)
Expr *ex;
{
    if (!check0_31(ex->args[0]))
        return ex;
    return makeexpr_bin(EK_LSH, tp_integer,
                        makeexpr_longcast(makeexpr_long(-1), 1),
                        makeexpr_minus(makeexpr_long(32),
                                       makeexpr_unlongcast(grabarg(ex, 0))));
}



/* This function does an arithmetic shift left, or right for negative shift
 * count.  We translate into a C shift only if we are confident of the
 * sign of the shift count.
 */

Static Expr *func_na_asl(ex)
Expr *ex;
{
    Expr *ex2;

    ex2 = makeexpr_unlongcast(copyexpr(ex->args[0]));
    if (expr_is_neg(ex2)) {
        if (signedshift == 0 || signedshift == 2)
            return ex;
	if (possiblesigns(ex2) & 4) {
            if (assumesigns)
                note("Assuming count for NA_ASL is negative [504]");
            else
                return ex;
        }
        if (signedshift != 1)
            note("Assuming >> is an arithmetic shift [505]");
        return makeexpr_bin(EK_RSH, tp_integer,
			    grabarg(ex, 1), makeexpr_neg(ex2));
    } else {
	if (possiblesigns(ex2) & 1) {
            if (assumesigns)
                note("Assuming count for NA_ASL is positive [504]");
            else
                return ex;
        }
        return makeexpr_bin(EK_LSH, tp_integer, grabarg(ex, 1), ex2);
    }
}



Static Expr *func_na_lsl(ex)
Expr *ex;
{
    Expr *ex2;

    ex2 = makeexpr_unlongcast(copyexpr(ex->args[0]));
    if (expr_is_neg(ex2)) {
	if (possiblesigns(ex2) & 4) {
            if (assumesigns)
                note("Assuming count for NA_LSL is negative [506]");
            else
                return ex;
        }
        return makeexpr_bin(EK_RSH, tp_integer, 
                            force_unsigned(grabarg(ex, 1)),
			    makeexpr_neg(ex2));
    } else {
	if (possiblesigns(ex2) & 1) {
            if (assumesigns)
                note("Assuming count for NA_LSL is positive [506]");
            else
                return ex;
        }
        return makeexpr_bin(EK_LSH, tp_integer, grabarg(ex, 1), ex2);
    }
}



/* These bit-field operations were generalized slightly on the way to C;
 * they used to perform D &= S and now perform D = S1 & S2.
 */

Static Stmt *proc_na_bfand(ex)
Expr *ex;
{
    Stmt *sp;
    Meaning *tvar;

    if (!nosideeffects(ex->args[2], 1)) {
        tvar = makestmttempvar(ex->args[2]->val.type, name_TEMP);
        sp = makestmt_assign(makeexpr_var(tvar), ex->args[2]);
        ex->args[2] = makeexpr_var(tvar);
    } else
        sp = NULL;
    insertarg(&ex, 1, copyexpr(ex->args[2]));
    return makestmt_seq(sp, makestmt_call(ex));
}



Static Stmt *proc_na_bfbic(ex)
Expr *ex;
{
    return proc_na_bfand(ex);
}



Static Stmt *proc_na_bfor(ex)
Expr *ex;
{
    return proc_na_bfand(ex);
}



Static Stmt *proc_na_bfxor(ex)
Expr *ex;
{
    return proc_na_bfand(ex);
}



Static Expr *func_imin(ex)
Expr *ex;
{
    return makeexpr_bicall_2("P_imin2", tp_integer,
                             ex->args[0], ex->args[1]);
}



Static Expr *func_imax(ex)
Expr *ex;
{
    return makeexpr_bicall_2("P_imax2", tp_integer,
                             ex->args[0], ex->args[1]);
}



/* Unsigned non-overflowing arithmetic functions in Pascal; we translate
 * into plain arithmetic in C and assume C doesn't check for overflow.
 * (A valid assumption in the case when this was used.)
 */

Static Expr *func_na_add(ex)
Expr *ex;
{
    return makeexpr_plus(makeexpr_unlongcast(ex->args[0]),
                         makeexpr_unlongcast(ex->args[1]));
}



Static Expr *func_na_sub(ex)
Expr *ex;
{
    return makeexpr_minus(makeexpr_unlongcast(ex->args[0]),
                          makeexpr_unlongcast(ex->args[1]));
}



extern Stmt *proc_exit();    /* from funcs.c */

Static Stmt *proc_return()
{
    return proc_exit();
}



Static Expr *func_charupper(ex)
Expr *ex;
{
    return makeexpr_bicall_1("toupper", tp_char,
                             grabarg(ex, 0));
}



Static Expr *func_charlower(ex)
Expr *ex;
{
    return makeexpr_bicall_1("tolower", tp_char,
                             grabarg(ex, 0));
}



/* Convert an integer to its string representation.  We produce a sprintf
 * into a temporary variable; the temporary will probably be eliminated
 * as the surrounding code is translated.
 */

Static Expr *func_strint(ex)
Expr *ex;
{
    Expr *ex2;

    ex2 = makeexpr_forcelongness(ex->args[1]);
    return makeexpr_bicall_3("sprintf", ex->val.type,
                             ex->args[0],
                             makeexpr_string((exprlongness(ex2) > 0) ? "%ld" : "%d"),
                             ex2);
}



Static Expr *func_strint2(ex)
Expr *ex;
{
    Expr *ex2, *len, *fmt;

    if (checkconst(ex->args[2], 0) || checkconst(ex->args[2], 1))
        return func_strint(ex);
    if (expr_is_neg(ex->args[2])) {
	if (possiblesigns(ex->args[2]) & 4) {
            if (assumesigns)
                note("Assuming width for STRINT2 is negative [507]");
            else
                return ex;
        }
        ex2 = makeexpr_forcelongness(ex->args[1]);
        fmt = makeexpr_string((exprlongness(ex2) > 0) ? "%0*ld" : "%0*d");
        len = makeexpr_neg(makeexpr_longcast(ex->args[2], 0));
    } else {
	if (possiblesigns(ex->args[2]) & 1) {
            if (assumesigns)
                note("Assuming width for STRINT2 is positive [507]");
            else
                return ex;
        }
        ex2 = makeexpr_forcelongness(ex->args[1]);
        fmt = makeexpr_string((exprlongness(ex2) > 0) ? "%*ld" : "%*d");
        len = makeexpr_longcast(ex->args[2], 0);
    }
    ex = makeexpr_bicall_4("sprintf", ex->val.type,
                           ex->args[0], fmt, len, ex2);
    return cleansprintf(ex);
}



Static Expr *func_strhex(ex)
Expr *ex;
{
    Expr *ex2, *ex3;
    Value val;

    if (isliteralconst(ex->args[2], &val) == 2) {
        ex2 = makeexpr_forcelongness(ex->args[1]);
        if (val.i < 1 || val.i > 8) {
            ex = makeexpr_bicall_3("sprintf", ex->val.type,
                                   ex->args[0],
                                   makeexpr_string((exprlongness(ex2) > 0) ? "%lX" : "%X"),
                                   ex2);
        } else {
            if (val.i < 8) {
                ex3 = makeexpr_long((1 << (val.i*4)) - 1);
                insertarg(&ex3, 0, makeexpr_name("%#lx", tp_integer));
                ex2 = makeexpr_bin(EK_BAND, ex2->val.type, ex2, ex3);
            }
            ex = makeexpr_bicall_3("sprintf", ex->val.type,
                                   ex->args[0],
                                   makeexpr_string(format_d((exprlongness(ex2) > 0) ? "%%.%ldlX" :
                                                                                      "%%.%ldX",
                                                            val.i)),
                                   ex2);
        }
    }
    return ex;
}



Static Expr *func_strreal(ex)
Expr *ex;
{
    return makeexpr_bicall_3("sprintf", ex->val.type,
                             ex->args[0],
                             makeexpr_string("%g"),
                             ex->args[1]);
}



Static Expr *func_strchar(ex)
Expr *ex;