cceval.c

KCC , a good c compiler, write by Ken Harrenstien

	case Q_ASDIV:			/* Check integral /= */
		if (icon == 0) {
		    advise("Division by zero ignored"); /* i/=0 => i */
		    return e->Nleft;
		} else if (icon == 1)
		    return e->Nleft;	/* i/=1 => i */
		else if (tissigned(e->Ntype))
		    e->Nop = N_NEG;	/* si/=(-1) => -si */
		break;			/*	(cannot do ui/(-1)) */

	case Q_ASMOD:			/* Check integral %= */
		if (!icon || icon == 1 || tissigned(e->Ntype)) {
		    if (icon == 0)		/* i%=0 => i=0 */
			advise("Division by zero");
		    e->Nright->Niconst = 0;	/* i%=1    => i=0   */
		    e->Nop = Q_ASGN;		/* si%=(-1) => si=0 */
		}				/* Note ui%(-1) is variable! */
		break;

	case Q_ASPLUS:			/* Check integral += */
		if (icon == 0)
		    return e->Nleft;	/* e+=0 => e */
		return evalincdec(e,
			(icon < 0)
			    ? N_PREDEC		/* e+=(-1) => --e */
			    : N_PREINC);	/* e-=1    => ++e */

	case Q_ASMINUS:			/* Check integral -= */
		if (icon == 0)
		    return e->Nleft;	/* e-=0 => e */
		return evalincdec(e,
			(icon < 0)
			    ? N_PREINC		/* e-=(-1) => ++e */
			    : N_PREDEC);	/* e-=1    => --e */

	case Q_ASLSH:			/* Check integral <<= and >>= */
	case Q_ASRSH:
		if (icon == 0)
		    return e->Nleft;	/* i<<=0 => i */
		break;
	case Q_ASAND:			/* Check integral &= */
		if (icon == 0)
		    e->Nop = Q_ASGN;	/* i&=0 => i=0 */
		else if (icon < 0)
		    return e->Nleft;	/* i&=(-1) => i */
		break;
	case Q_ASOR:			/* Check integral |= */
		if (icon == 0)
		    return e->Nleft;	/* i|=0 => i */
		if (icon < 0)
		    e->Nop = Q_ASGN;	/* i|=(-1) => i=(-1) */
		break;
	case Q_ASXOR:
		if (icon == 0)		/* Check integral ^= */
		    return e->Nleft;	/* i^=0 => i */
		if (icon < 0)
		    e->Nop = Q_COMPL;	/* i^=(-1) => ~i */
		break;

	} else if ((icon&(icon-1))==0
		 && tisunsign(e->Ntype)) {
	    /* Last hope - if constant is right-hand and a power of 2,
	    ** (yes, that expression works as a test!) then
	    ** good optimizations are possible for unsigned *,/,%.
	    ** Don't do it for * because multiply-to-memory is easy,
	    ** and we have no shift-to-memory instruction.
	    ** But for division it's probably worthwhile.
	    */
#if 0 /* See above comment */
	    if (e->Nop == Q_ASMPLY) {	/* ui*=log2(n) becomes ui<<=n */
		e->Nop = Q_ASLSH;
		e->Nright->Niconst = binexp(icon);
		e->Nright->Ntype = inttype;	/* Be safe */
		return e;
	    }
#endif
	    if (e->Nop == Q_ASDIV) {	/* ui/=log2(n) => ui>>=n */
		e->Nop = Q_ASRSH;
		e->Nright->Niconst = binexp(icon);
		e->Nright->Ntype = inttype;
		return e;
	    }
	    if (e->Nop == Q_ASMOD) {	/* ui%=log2(n) => ui&=(n-1) */
		e->Nop = Q_ASAND;
		e->Nright->Niconst = icon-1;
		/* preserve prior type of constant */
		return e;
	    }
	}
    } else if (tisfloat(e->Ntype)) {	/* Check floating types */
	if (e->Ntype->Tspec != TS_LNGDBL) {	/* Someday may be different */
	    double fcon;
	    if (e->Nright->Nop != N_FCONST)
		return e;			/* Just in case */
	    fcon = e->Nright->Nfconst;
	    if (fcon == 0.0 || fcon == 1.0 || fcon == -1.0) switch (e->Nop) {
	    case Q_ASMPLY:
		if (fcon == 0.0) {
		    e->Nop = Q_ASGN;		/* f*=0 => f=0 */
		    break;
		}
		/* Drop thru to check for f/0, f/1 and f/(-1) */
	    case Q_ASDIV:
		if (fcon == 0.0) {		/* f/=0 => f */
		    advise("Division by zero ignored");
		    return e->Nleft;
		} else if (fcon > 0.0)
		    return e->Nleft;		/* f*=1 or f/=1 => f */
		else e->Nop = N_NEG;		/* f*=(-1) or f/=(-1) => -f */
		break;
	    case Q_ASPLUS:
		if (fcon == 0.0)
		    return e->Nleft;		/* f+=0 => f */
		return evalincdec(e,
			(fcon > 0)
			    ? N_PREINC		/* f+=1    => ++f */
			    : N_PREDEC);	/* f+=(-1) => --f */
	    case Q_ASMINUS:
		if (fcon == 0.0)
		    return e->Nleft;		/* f-=0 => f */
		return evalincdec(e,
			(fcon > 0)
			    ? N_PREDEC		/* f-=1    => --f */
			    : N_PREINC);	/* f-=(-1) => ++f */
	    }
	}
    } else {	/* Not integral or float, must be pointer. */
	INT icon;
	if (e->Nright->Nop == N_ICONST	/* Ensure integer const op */
	  && (icon = e->Nright->Niconst) >= -1
	  && icon <= 1
	  && (e->Nop == Q_ASPLUS || e->Nop == Q_ASMINUS)) {
	    if (icon == 0) {		/* ptr += 0  => ptr  */
		/* Beware of funny array type conversion
		** sometimes applied to plus/minus pointer arithmetic;
		** result type may not be same as operand type.
		** Keep result type!!
		*/
		e->Nleft->Ntype = e->Ntype;	/* Propagate result type */
		return e->Nleft;
	    }
	    return evalincdec(e,
	    	(e->Nop==Q_ASPLUS)
		? (icon > 0 ? N_PREINC : N_PREDEC)	/* p+=1 => ++p */
		: (icon > 0 ? N_PREDEC : N_PREINC));	/* p-=1 => --p */
	}
    }

#endif
    return e;
}

/* EVALINCDEC - Optimize assign op to inc/dec.  Auxiliary for EVALASOP above.
**	Used when about to change an assignment operator (type TKTY_ASOP)
** into an increment/decrement operator, to check for and flush any
** internal casts inserted by the parser.  Although the code generator
** for assignment knows how to deal with these internal casts, the inc/dec
** part doesn't.  The reason for removing them here instead of in CCGEN2's
** gincdec() is just so that if there is a problem, we can still recover
** by not doing the optimization.
** See the info in INTERN.DOC for more details about TKTY_ASOP nodes.
*/
static NODE *
evalincdec(NODE *e, int op)  /* Expr node optimized and Desired inc/dec op */
{
    if (e->Nleft->Nop == N_CAST) {
	/* Internal cast, must remove it.  Do check to make sure it's
	** really a valid cast (paranoia dept).  Type of operand being
	** cast must be exactly the same as the asop result type.
	*/
	if (e->Ntype != e->Nleft->Nleft->Ntype) {
	    int_warn("evalincdec: bad cast");
	    return e;			/* Don't do it */
	}
	e->Nleft = e->Nleft->Nleft;	/* Snip out the cast */
    }
    e->Nop = op;
    return e;
}

/*
** Copy flags and such across from old top node
** Used when op has been folded out but we still want to keep its info
** WARNING!  This may not work if Nflag is really being used as
** something else.  See the union definition for NODE in cc.h.
*/

static NODE *
copyflag (NODE *new, NODE *old)
{
    new->Ntype = old->Ntype;
    new->Nflag = old->Nflag;
    return new;
}

/* SETLOG - Sets and returns a logical operator result.
**	Node given as arg must be that of the operator (not an operand).
*/
static NODE *
setlog(NODE *e, int res) /* Operator node and Result (either 0 or 1) */
{
    if (e->Ntype != inttype) {
	int_error("setlog: bad type");
	e->Ntype = inttype;
    }
    e->Nop = N_ICONST;
    e->Niconst = res;
    return e;
}

/* EVALCAST - called to evaluate a constant cast expression
**	Arg is a N_CAST node; operand is one of N_ICONST, N_PCONST, N_FCONST.
** To minimize the number of conversion combinations, values are always stored
** in the constant node using the largest possible type.
** For integers this is "long":
**	If the type is unsigned, unused bits in Niconst will be 0.
**	If signed, then sign extension has been done in Niconst.
** For floating-point this is "double":
**	If the type is float, precision will have been truncated (2nd word 0).
**
*/

static NODE *
evalcast(NODE *e)
{
    NODE *cn = e->Nleft;	/* Get pointer to constant node */
    TYPE *tfrom = cn->Ntype;	/* Converting from this typespec */
    TYPE *tto = e->Ntype;	/* to this one */

    switch ((int) e->Ncast) {
	case CAST_ILL:		/* Illegal cast from error? */
	    return e;		/* Should already have complained */

	case CAST_NONE:		/* no actual conversion needed */
	    break;		/* Just copy flags and set new type */

	case CAST_VOID:		/* Any type to void type (discard constant) */
	    cn->Nop = N_VCONST;	/* Change node op to special value */
	    break;

	case CAST_IT_IT:	/* Integer type to integer type */
	    cn->Niconst = tolong(tto, cn->Niconst);
	    break;
	case CAST_FP_IT:	/* Floating-point type to integer type */
	    cn->Niconst = tolong(tto, (long) cn->Nfconst);
	    cn->Nop = N_ICONST;
	    break;
	case CAST_EN_IT:	/* Enumeration type to integer type */
	case CAST_PT_IT:	/* Pointer type to integer type */
	    cn->Niconst = tolong(tto, (long) cn->Niconst);
	    cn->Nop = N_ICONST;
	    break;

	case CAST_FP_FP:	/* Floating-point type to floating-pt type */
	    switch (castidx(tfrom->Tspec, tto->Tspec)) {
		case castidx(TS_DOUBLE,TS_FLOAT):
		case castidx(TS_LNGDBL,TS_FLOAT):
		    cn->Nfconst = (float) cn->Nfconst;
		    break;
		case castidx(TS_FLOAT,TS_DOUBLE):
		case castidx(TS_FLOAT,TS_LNGDBL):
		    cn->Nfconst = (double)(float) cn->Nfconst;
		    break;
		case castidx(TS_LNGDBL,TS_DOUBLE):
		case castidx(TS_DOUBLE,TS_LNGDBL):
		    break;
		default:
		    int_warn("evalcast: bad fp_fp");
		    break;
	    }
	    break;

	case CAST_IT_FP:	/* Integer type to floating-point type */
	    switch (tto->Tspec) {
		case TS_FLOAT:
		    if (tissigned(tfrom))
			cn->Nfconst = (float) cn->Niconst;
		    else
			cn->Nfconst = (float) (unsigned long) cn->Niconst;
		    break;
		case TS_DOUBLE:
		case TS_LNGDBL:
		    if (tissigned(tfrom))
			cn->Nfconst = (double) cn->Niconst;
		    else
			cn->Nfconst = (double) (unsigned long) cn->Niconst;
		    break;
	    }
	    cn->Nop = N_FCONST;
	    break;

	case CAST_EN_EN:	/* Enumeration type to enumeration type */
	case CAST_IT_EN:	/* Integer type to enumeration type */
	    break;

	/* The only pointer-pointer conversions we can guarantee are
	** those from byte ptrs to word ptrs.  Going the other way
	** depends on the type and the KCC runtime section and will
	** produce different results, so we have to do it at run time.
	*/
	case CAST_PT_PT:	/* Pointer type to pointer type */
	    if (tisbytepointer(tfrom) && !tisbytepointer(tto))
		    cn->Niconst = (long)(INT *)(char *)(cn->Niconst);
	    else return e;
	    break;

	case CAST_IT_PT:	/* Integer type to pointer type */
	    cn->Nop = N_PCONST;
	    break;

	default:
	    int_warn("evalcast: bad cast: %d", (int) e->Ncast);
	    return e;
    }
    return copyflag(cn, e);
}

/* TOLONG - Convert a long integer value to some intermediate type and
**	then back to a long value.
**	Note special handling for chars, which KCC allows to
**	have varied byte sizes.
*/
static long
tolong(TYPE *t, long val)
{
    switch(t->Tspec) {
	case TS_SHORT:	return (short) val;
	case TS_INT:	return (int) val;
	case TS_LONG:	return (long) val;
	case TS_USHORT:	return (unsigned short) val;
	case TS_UINT:	return (unsigned int) val;
	case TS_ULONG:	return (unsigned long) val;

	case TS_BITF:
	case TS_CHAR:  /* return (char) val;          */
	    if (val & (1 << (tbitsize(t)-1)))	/* If sign bit set */
		return val | (((long)-1) << tbitsize(t));
	    /* Else drop through to handle like unsigned */

	case TS_UBITF:
	case TS_UCHAR: /* return (unsigned char) val; */
	    return val & ((1<<tbitsize(t))-1);	/* Mask off */

	default:
	    int_error("tolong: bad type");
	    return 0;
    }
}

#if 0
static NODE *
setnode(NODE *new, NODE *old,int nop)
{
    new->Ntype = old->Ntype;
    new->Nflag = old->Nflag;
    new->Nop = nop;
    return new;
}
#endif

/* ---------------------------------------- */
/*      commute tree to canonical form      */
/* ---------------------------------------- */

#define HBAR	64			/* basic unit of complexity */

#define IDMASK	    (HBAR-1)		/* mask for quantum fluctuations */
#define	IDWEIGHT(s) (hash(s->Sname)&IDMASK) /* to permute for common subs */

#define	BWEIGHT	(4*HBAR)		/* weight for binary operator */
#define	IWEIGHT	0			/* weight for integer */
#define	SWEIGHT	(2*HBAR)		/* weight for string const */
#define	MWEIGHT	HBAR			/* weight for struct member */
#define CWEIGHT	(2*HBAR)		/* weight for coercion, unary */
#define	FWEIGHT	(32*HBAR)		/* weight for fun call - v expensive */
#define	QWEIGHT	(2*HBAR)		/* weight for ternary */

static INT
ecanon(NODE *n)
{
    NODE *t;
    INT x, y;

    /*
    ** Return a weight for the tree, and commute subtrees.
    ** This function has two purposes:
    **   - To rearrange commutative expressions so that the more
    **     expensive operation is performed first, so that fewer
    **     registers need be allocated at once and so that moves
    **     from memory are more likely to be folded into the ops.
    **   - To permute equivalent expressions to the same canonical
    **     form, so that common subexpression elimination may be
    **     more likely to find them.
    */

    if (n) switch (n->Nop) {
    case N_ICONST:
	return IWEIGHT;
    case Q_IDENT:
	return IDWEIGHT(n->Nid)
		/* Hack so new array/funct conversion code
		** comes out looking the same as before --KLH
		*/
		+ (
		((n->Ntype != n->Nid->Stype) || n->Ntype->Tspec == TS_FUNCT)
			? CWEIGHT : 0);

    case N_SCONST:
	return SWEIGHT;
    case Q_DOT:
    case Q_MEMBER:
	return ecanon(n->Nleft) + MWEIGHT;
    case N_EXPRLIST:
	if (n->Nleft == NULL) return ecanon(n->Nright);
	return ecanon(n->Nleft) + ecanon(n->Nright);
    case N_CAST:
	return ecanon(n->Nleft) + CWEIGHT;
    case N_FNCALL:
	return (n->Nright == NULL) ? FWEIGHT : ecanon(n->Nright)+FWEIGHT;
    default:
	switch (tok[n->Nop].tktype) {
	case TKTY_BINOP:
	    x = ecanon(n->Nleft);
	    y = ecanon(n->Nright);
	    if (y > x && (n->Nop == Q_PLUS || n->Nop == Q_MPLY)) {
		t = n->Nleft;
		n->Nleft = n->Nright;
		n->Nright = t;
	    }
            return x + y + BWEIGHT;
	case TKTY_ASOP:
	case TKTY_BOOLOP:
	    return ecanon(n->Nleft) + ecanon(n->Nright) + BWEIGHT;
	case TKTY_UNOP:
	case TKTY_BOOLUN:
            return ecanon(n->Nleft)+CWEIGHT;
	case TKTY_TERNARY:
	    x = ecanon(n->Nright->Nleft);
	    y = ecanon(n->Nright->Nright);
	    if (y > x) x = y;
            return ecanon(n->Nleft) + x + QWEIGHT;
	default:
	    break;
	}
    }
    return 0;
}

#if 0	/* Comments about discarded values */

	There are three ways used internally within KCC to indicate
to the code generator that an expression's value is to be discarded: