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





void free_value(val)
Value *val;
{
    if (!val || !val->type)
	return;
    switch (val->type->kind) {

        case TK_STRING:
        case TK_REAL:
        case TK_ARRAY:
        case TK_RECORD:
        case TK_SET:
            if (val->s)
                FREE(val->s);
            break;

	default:
	    break;
    }
}


Value copyvalue(val)
Value val;
{
    char *cp;

    switch (val.type->kind) {

        case TK_STRING:
        case TK_SET:
            if (val.s) {
                cp = ALLOC(val.i+1, char, literals);
                memcpy(cp, val.s, val.i);
		cp[val.i] = 0;
                val.s = cp;
            }
            break;

        case TK_REAL:
        case TK_ARRAY:
        case TK_RECORD:
            if (val.s)
                val.s = stralloc(val.s);
            break;

	default:
	    break;
    }
    return val;
}


int valuesame(a, b)
Value a, b;
{
    if (a.type != b.type)
        return 0;
    switch (a.type->kind) {

        case TK_INTEGER:
        case TK_CHAR:
        case TK_BOOLEAN:
        case TK_ENUM:
        case TK_SMALLSET:
        case TK_SMALLARRAY:
            return (a.i == b.i);

        case TK_STRING:
        case TK_SET:
            return (a.i == b.i && !memcmp(a.s, b.s, a.i));

        case TK_REAL:
        case TK_ARRAY:
        case TK_RECORD:
            return (!strcmp(a.s, b.s));

        default:
            return 1;
    }
}



char *value_name(val, intfmt, islong)
Value val;
char *intfmt;
int islong;
{
    Meaning *mp;
    Type *type = val.type;

    if (type->kind == TK_SUBR)
	type = type->basetype;
    switch (type->kind) {

        case TK_INTEGER:
        case TK_SMALLSET:
        case TK_SMALLARRAY:
            if (!intfmt)
		intfmt = "%ld";
	    if (*intfmt == '\'') {
		if (val.i >= -'~' && val.i <= -' ') {
		    intfmt = format_s("-%s", intfmt);
		    val.i = -val.i;
		}
		if (val.i < ' ' || val.i > '~' || islong)
		    intfmt = "%ld";
	    }
            if (islong)
                intfmt = format_s("%sL", intfmt);
            return format_d(intfmt, val.i);

        case TK_REAL:
            return val.s;

        case TK_ARRAY:    /* obsolete */
        case TK_RECORD:   /* obsolete */
            return val.s;

        case TK_STRING:
            return makeCstring(val.s, val.i);

        case TK_BOOLEAN:
            if (!intfmt)
                if (val.i == 1 && *name_TRUE &&
		    strcmp(name_TRUE, "1") && !islong)
                    intfmt = name_TRUE;
                else if (val.i == 0 && *name_FALSE &&
			 strcmp(name_FALSE, "0") && !islong)
                    intfmt = name_FALSE;
                else
                    intfmt = "%ld";
            if (islong)
                intfmt = format_s("%sL", intfmt);
            return format_d(intfmt, val.i);

        case TK_CHAR:
            if (islong)
                return format_d("%ldL", val.i);
	    else if ((val.i < 0 || val.i > 127) && highcharints)
		return format_d("%ld", val.i);
            else
                return makeCchar(val.i);

        case TK_POINTER:
            return (*name_NULL) ? name_NULL : "NULL";

        case TK_ENUM:
            mp = val.type->fbase;
            while (mp && mp->val.i != val.i)
                mp = mp->xnext;
            if (!mp) {
                intwarning("value_name", "bad enum value [152]");
                return format_d("%ld", val.i);
            }
            return mp->name;

        default:
            intwarning("value_name", format_s("bad type for constant: %s [153]",
                                              typekindname(type->kind)));
            return "<spam>";
    }
}




Value value_cast(val, type)
Value val;
Type *type;
{
    char buf[20];

    if (type->kind == TK_SUBR)
        type = type->basetype;
    if (val.type == type)
        return val;
    if (type && val.type) {
        switch (type->kind) {

            case TK_REAL:
                if (ord_type(val.type)->kind == TK_INTEGER) {
                    sprintf(buf, "%ld.0", val.i);
                    val.s = stralloc(buf);
                    val.type = tp_real;
                    return val;
                }
                break;

            case TK_CHAR:
                if (val.type->kind == TK_STRING) {
                    if (val.i != 1)
                        if (val.i > 0)
                            warning("Char constant with more than one character [154]");
                        else
                            warning("Empty char constant [155]");
                    val.i = val.s[0] & 0xff;
                    val.s = NULL;
                    val.type = tp_char;
                    return val;
                }

            case TK_POINTER:
                if (val.type == tp_anyptr && castnull != 1) {
                    val.type = type;
                    return val;
                }

	    default:
		break;
        }
    }
    val.type = NULL;
    return val;
}



Type *ord_type(tp)
Type *tp;
{
    if (!tp) {
        warning("Expected a constant [127]");
        return tp_integer;
    }
    switch (tp->kind) {

        case TK_SUBR:
            tp = tp->basetype;
            break;

        case TK_STRING:
            if (!CHECKORDEXPR(tp->indextype->smax, 1))
                tp = tp_char;
            break;

	default:
	    break;

    }
    return tp;
}



int long_type(tp)
Type *tp;
{
    switch (tp->kind) {

        case TK_INTEGER:
            return (tp != tp_int && tp != tp_uint && tp != tp_sint);

        case TK_SUBR:
            return (findbasetype(tp, ODECL_NOPRES) == tp_integer);

        default:
            return 0;
    }
}



Value make_ord(type, i)
Type *type;
long i;
{
    Value val;

    if (type->kind == TK_ENUM)
        type = findbasetype(type, ODECL_NOPRES);
    if (type->kind == TK_SUBR)
        type = type->basetype;
    val.type = type;
    val.i = i;
    val.s = NULL;
    return val;
}



long ord_value(val)
Value val;
{
    switch (val.type->kind) {

        case TK_INTEGER:
        case TK_ENUM:
        case TK_CHAR:
        case TK_BOOLEAN:
            return val.i;

        case TK_STRING:
            if (val.i == 1)
                return val.s[0] & 0xff;

        /* fall through */
        default:
            warning("Expected an ordinal type [156]");
            return 0;
    }
}



void ord_range_expr(type, smin, smax)
Type *type;
Expr **smin, **smax;
{
    if (!type) {
        warning("Expected a constant [127]");
        type = tp_integer;
    }
    if (type->kind == TK_STRING)
        type = tp_char;
    switch (type->kind) {

        case TK_SUBR:
        case TK_INTEGER:
        case TK_ENUM:
        case TK_CHAR:
        case TK_BOOLEAN:
            if (smin) *smin = type->smin;
            if (smax) *smax = type->smax;
            break;

        default:
            warning("Expected an ordinal type [156]");
            if (smin) *smin = makeexpr_long(0);
            if (smax) *smax = makeexpr_long(1);
            break;
    }
}


int ord_range(type, smin, smax)
Type *type;
long *smin, *smax;
{
    Expr *emin, *emax;
    Value vmin, vmax;

    ord_range_expr(type, &emin, &emax);
    if (smin) {
        vmin = eval_expr(emin);
        if (!vmin.type)
            return 0;
    }
    if (smax) {
        vmax = eval_expr(emax);
        if (!vmax.type)
            return 0;
    }
    if (smin) *smin = ord_value(vmin);
    if (smax) *smax = ord_value(vmax);
    return 1;
}







void freeexpr(ex)
register Expr *ex;
{
    register int i;

    if (ex) {
        for (i = 0; i < ex->nargs; i++)
            freeexpr(ex->args[i]);
        switch (ex->kind) {

            case EK_CONST:
            case EK_LONGCONST:
                free_value(&ex->val);
                break;

            case EK_DOT:
            case EK_NAME:
            case EK_BICALL:
                if (ex->val.s)
                    FREE(ex->val.s);
                break;

	    default:
		break;
        }
        FREE(ex);
    }
}




Expr *makeexpr(kind, n)
enum exprkind kind;
int n;
{
    Expr *ex;

    ex = ALLOCV(sizeof(Expr) + (n-1)*sizeof(Expr *), Expr, exprs);
    ex->val.i = 0;
    ex->val.s = NULL;
    ex->kind = kind;
    ex->nargs = n;
    return ex;
}


Expr *makeexpr_un(kind, type, arg1)
enum exprkind kind;
Type *type;
Expr *arg1;
{
    Expr *ex;

    ex = makeexpr(kind, 1);
    ex->val.type = type;
    ex->args[0] = arg1;
    if (debug>2) { fprintf(outf,"makeexpr_un returns "); dumpexpr(ex); fprintf(outf,"\n"); }
    return ex;
}


Expr *makeexpr_bin(kind, type, arg1, arg2)
enum exprkind kind;
Type *type;
Expr *arg1, *arg2;
{
    Expr *ex;

    ex = makeexpr(kind, 2);
    ex->val.type = type;
    ex->args[0] = arg1;
    ex->args[1] = arg2;
    if (debug>2) { fprintf(outf,"makeexpr_bin returns "); dumpexpr(ex); fprintf(outf,"\n"); }
    return ex;
}



Expr *makeexpr_val(val)
Value val;
{
    Expr *ex;

    if (val.type->kind == TK_INTEGER &&
        (val.i < -32767 || val.i > 32767) &&
        sizeof_int < 32)
        ex = makeexpr(EK_LONGCONST, 0);
    else
        ex = makeexpr(EK_CONST, 0);
    ex->val = val;
    if (debug>2) { fprintf(outf,"makeexpr_val returns "); dumpexpr(ex); fprintf(outf,"\n"); }
    return ex;
}



Expr *makeexpr_char(c)
int c;
{
    return makeexpr_val(make_ord(tp_char, c));
}


Expr *makeexpr_long(i)
long i;
{
    return makeexpr_val(make_ord(tp_integer, i));
}


Expr *makeexpr_real(r)
char *r;
{
    Value val;

    val.type = tp_real;
    val.i = 0;
    val.s = stralloc(r);
    return makeexpr_val(val);
}


Expr *makeexpr_lstring(msg, len)
char *msg;
int len;
{
    Value val;

    val.type = tp_str255;
    val.i = len;
    val.s = ALLOC(len+1, char, literals);
    memcpy(val.s, msg, len);
    val.s[len] = 0;
    return makeexpr_val(val);
}


Expr *makeexpr_string(msg)
char *msg;
{
    Value val;

    val.type = tp_str255;
    val.i = strlen(msg);
    val.s = stralloc(msg);
    return makeexpr_val(val);
}


int checkstring(ex, msg)
Expr *ex;
char *msg;
{
    if (!ex || ex->val.type->kind != TK_STRING || ex->kind != EK_CONST)
        return 0;
    if (ex->val.i != strlen(msg))
        return 0;
    return memcmp(ex->val.s, msg, ex->val.i) == 0;
}



Expr *makeexpr_var(mp)
Meaning *mp;
{