rval.c

早期freebsd实现

			     */
			p = rvalue( r->expr_node.lhs , contype , RREQ );
			if ( p == NLNIL ) {
			    return NLNIL;
			}
			    /*
			     * since the second pass can't do
			     *	long op double  or  double op long
			     * we may have to do some coercing.
			     */
			tuac(p, p1, &rettype, (int *) (&ctype));
			p1 = rvalue( r->expr_node.rhs , p , RREQ );
			if ( p1 == NLNIL ) {
			    return NLNIL;
			}
			tuac(p1, p, &rettype, (int *) (&ctype));
			putop((int) relops[ r->tag - T_EQ ] , PCCT_INT );
			sconv(PCCT_INT, PCCT_CHAR);
		    }
#		endif PC
		c = classify(p);
		c1 = classify(p1);
		if (nocomp(c) || nocomp(c1))
			return (NLNIL);
#		ifdef OBJ
		    g = NIL;
#		endif
		switch (c) {
			case TBOOL:
			case TCHAR:
				if (c != c1)
					goto clash;
				break;
			case TINT:
			case TDOUBLE:
				if (c1 != TINT && c1 != TDOUBLE)
					goto clash;
				break;
			case TSCAL:
				if (c1 != TSCAL)
					goto clash;
				if (scalar(p) != scalar(p1))
					goto nonident;
				break;
			case TSET:
				if (c1 != TSET)
					goto clash;
				if ( opt( 's' ) &&
				    ( ( r->tag == T_LT) || (r->tag == T_GT) ) &&
				    ( line != nssetline ) ) {
				    nssetline = line;
				    standard();
				    error("%s comparison on sets is non-standard" , opname );
				}
				if (p != p1)
					goto nonident;
#				ifdef OBJ
				    g = TSET;
#				endif
				break;
			case TREC:
				if ( c1 != TREC ) {
				    goto clash;
				}
				if ( p != p1 ) {
				    goto nonident;
				}
				if (r->tag != T_EQ && r->tag != T_NE) {
					error("%s not allowed on records - only allow = and <>" , opname );
					return (NLNIL);
				}
#				ifdef OBJ
				    g = TREC;
#				endif
				break;
			case TPTR:
			case TNIL:
				if (c1 != TPTR && c1 != TNIL)
					goto clash;
				if (r->tag != T_EQ && r->tag != T_NE) {
					error("%s not allowed on pointers - only allow = and <>" , opname );
					return (NLNIL);
				}
				if (p != nl+TNIL && p1 != nl+TNIL && p != p1)
					goto nonident;
				break;
			case TSTR:
				if (c1 != TSTR)
					goto clash;
				if (width(p) != width(p1)) {
					error("Strings not same length in %s comparison", opname);
					return (NLNIL);
				}
#				ifdef OBJ
				    g = TSTR;
#				endif OBJ
				break;
			default:
				panic("rval2");
		}
#		ifdef OBJ
		    return (gen(g, r->tag, width(p), width(p1)));
#		endif OBJ
#		ifdef PC
		    return nl + TBOOL;
#		endif PC
clash:
		error("%ss and %ss cannot be compared - operator was %s", clnames[c], clnames[c1], opname);
		return (NLNIL);
nonident:
		error("%s types must be identical in comparisons - operator was %s", clnames[c1], opname);
		return (NLNIL);

	case T_IN:
	    rt = r->expr_node.rhs;
#	    ifdef OBJ
		if (rt != TR_NIL && rt->tag == T_CSET) {
			(void) precset( rt , NLNIL , &csetd );
			p1 = csetd.csettype;
			if (p1 == NLNIL)
			    return NLNIL;
			postcset( rt, &csetd);
		    } else {
			p1 = stkrval(r->expr_node.rhs, NLNIL , (long) RREQ );
			rt = TR_NIL;
		    }
#		endif OBJ
#		ifdef PC
		    if (rt != TR_NIL && rt->tag == T_CSET) {
			if ( precset( rt , NLNIL , &csetd ) ) {
			    putleaf( PCC_ICON , 0 , 0
				    , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
				    , "_IN" );
			} else {
			    putleaf( PCC_ICON , 0 , 0
				    , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
				    , "_INCT" );
			}
			p1 = csetd.csettype;
			if (p1 == NIL)
			    return NLNIL;
		    } else {
			putleaf( PCC_ICON , 0 , 0
				, PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
				, "_IN" );
			codeoff();
			p1 = rvalue(r->expr_node.rhs, NLNIL , LREQ );
			codeon();
		    }
#		endif PC
		p = stkrval(r->expr_node.lhs, NLNIL , (long) RREQ );
		if (p == NIL || p1 == NIL)
			return (NLNIL);
		if (p1->class != (char) SET) {
			error("Right operand of 'in' must be a set, not %s", nameof(p1));
			return (NLNIL);
		}
		if (incompat(p, p1->type, r->expr_node.lhs)) {
			cerror("Index type clashed with set component type for 'in'");
			return (NLNIL);
		}
		setran(p1->type);
#		ifdef OBJ
		    if (rt == TR_NIL || csetd.comptime)
			    (void) put(4, O_IN, width(p1), set.lwrb, set.uprbp);
		    else
			    (void) put(2, O_INCT,
				(int)(3 + csetd.singcnt + 2*csetd.paircnt));
#		endif OBJ
#		ifdef PC
		    if ( rt == TR_NIL || rt->tag != T_CSET ) {
			putleaf( PCC_ICON , set.lwrb , 0 , PCCT_INT , (char *) 0 );
			putop( PCC_CM , PCCT_INT );
			putleaf( PCC_ICON , set.uprbp , 0 , PCCT_INT , (char *) 0 );
			putop( PCC_CM , PCCT_INT );
			p1 = rvalue( r->expr_node.rhs , NLNIL , LREQ );
			if ( p1 == NLNIL ) {
			    return NLNIL;
			}
			putop( PCC_CM , PCCT_INT );
		    } else if ( csetd.comptime ) {
			putleaf( PCC_ICON , set.lwrb , 0 , PCCT_INT , (char *) 0 );
			putop( PCC_CM , PCCT_INT );
			putleaf( PCC_ICON , set.uprbp , 0 , PCCT_INT , (char *) 0 );
			putop( PCC_CM , PCCT_INT );
			postcset( r->expr_node.rhs , &csetd );
			putop( PCC_CM , PCCT_INT );
		    } else {
			postcset( r->expr_node.rhs , &csetd );
		    }
		    putop( PCC_CALL , PCCT_INT );
		    sconv(PCCT_INT, PCCT_CHAR);
#		endif PC
		return (nl+T1BOOL);
	default:
		if (r->expr_node.lhs == TR_NIL)
			return (NLNIL);
		switch (r->tag) {
		default:
			panic("rval3");


		/*
		 * An octal number
		 */
		case T_BINT:
			f.pdouble = a8tol(r->const_node.cptr);
			goto conint;
	
		/*
		 * A decimal number
		 */
		case T_INT:
			f.pdouble = atof(r->const_node.cptr);
conint:
			if (f.pdouble > MAXINT || f.pdouble < MININT) {
				error("Constant too large for this implementation");
				return (NLNIL);
			}
			l = f.pdouble;
#			ifdef OBJ
			    if (bytes(l, l) <= 2) {
				    (void) put(2, O_CON2, ( short ) l);
				    return (nl+T2INT);
			    }
			    (void) put(2, O_CON4, l); 
			    return (nl+T4INT);
#			endif OBJ
#			ifdef PC
			    switch (bytes(l, l)) {
				case 1:
				    putleaf(PCC_ICON, (int) l, 0, PCCT_CHAR, 
						(char *) 0);
				    return nl+T1INT;
				case 2:
				    putleaf(PCC_ICON, (int) l, 0, PCCT_SHORT, 
						(char *) 0);
				    return nl+T2INT;
				case 4:
				    putleaf(PCC_ICON, (int) l, 0, PCCT_INT,
						(char *) 0);
				    return nl+T4INT;
			    }
#			endif PC
	
		/*
		 * A floating point number
		 */
		case T_FINT:
#			ifdef OBJ
			    (void) put(2, O_CON8, atof(r->const_node.cptr));
#			endif OBJ
#			ifdef PC
			    putCON8( atof( r->const_node.cptr ) );
#			endif PC
			return (nl+TDOUBLE);
	
		/*
		 * Constant strings.  Note that constant characters
		 * are constant strings of length one; there is
		 * no constant string of length one.
		 */
		case T_STRNG:
			cp = r->const_node.cptr;
			if (cp[1] == 0) {
#				ifdef OBJ
				    (void) put(2, O_CONC, cp[0]);
#				endif OBJ
#				ifdef PC
				    putleaf( PCC_ICON , cp[0] , 0 , PCCT_CHAR ,
						(char *) 0 );
#				endif PC
				return (nl+T1CHAR);
			}
			goto cstrng;
		}
	
	}
}

/*
 * Can a class appear
 * in a comparison ?
 */
nocomp(c)
	int c;
{

	switch (c) {
		case TREC:
			if ( line != reccompline ) {
			    reccompline = line;
			    warning();
			    if ( opt( 's' ) ) {
				standard();
			    }
			    error("record comparison is non-standard");
			}
			break;
		case TFILE:
		case TARY:
			error("%ss may not participate in comparisons", clnames[c]);
			return (1);
	}
	return (NIL);
}

    /*
     *	this is sort of like gconst, except it works on expression trees
     *	rather than declaration trees, and doesn't give error messages for
     *	non-constant things.
     *	as a side effect this fills in the con structure that gconst uses.
     *	this returns TRUE or FALSE.
     */

bool 
constval(r)
	register struct tnode *r;
{
	register struct nl *np;
	register struct tnode *cn;
	char *cp;
	int negd, sgnd;
	long ci;

	con.ctype = NIL;
	cn = r;
	negd = sgnd = 0;
loop:
	    /*
	     *	cn[2] is nil if error recovery generated a T_STRNG
	     */
	if (cn == TR_NIL || cn->expr_node.lhs == TR_NIL)
		return FALSE;
	switch (cn->tag) {
		default:
			return FALSE;
		case T_MINUS:
			negd = 1 - negd;
			/* and fall through */
		case T_PLUS:
			sgnd++;
			cn = cn->un_expr.expr;
			goto loop;
		case T_NIL:
			con.cpval = NIL;
			con.cival = 0;
			con.crval = con.cival;
			con.ctype = nl + TNIL;
			break;
		case T_VAR:
			np = lookup(cn->var_node.cptr);
			if (np == NLNIL || np->class != CONST) {
				return FALSE;
			}
			if ( cn->var_node.qual != TR_NIL ) {
				return FALSE;
			}
			con.ctype = np->type;
			switch (classify(np->type)) {
				case TINT:
					con.crval = np->range[0];
					break;
				case TDOUBLE:
					con.crval = np->real;
					break;
				case TBOOL:
				case TCHAR:
				case TSCAL:
					con.cival = np->value[0];
					con.crval = con.cival;
					break;
				case TSTR:
					con.cpval = (char *) np->ptr[0];
					break;
				default:
					con.ctype = NIL;
					return FALSE;
			}
			break;
		case T_BINT:
			con.crval = a8tol(cn->const_node.cptr);
			goto restcon;
		case T_INT:
			con.crval = atof(cn->const_node.cptr);
			if (con.crval > MAXINT || con.crval < MININT) {
				derror("Constant too large for this implementation");
				con.crval = 0;
			}
restcon:
			ci = con.crval;
#ifndef PI0
			if (bytes(ci, ci) <= 2)
				con.ctype = nl+T2INT;
			else	
#endif
				con.ctype = nl+T4INT;
			break;
		case T_FINT:
			con.ctype = nl+TDOUBLE;
			con.crval = atof(cn->const_node.cptr);
			break;
		case T_STRNG:
			cp = cn->const_node.cptr;
			if (cp[1] == 0) {
				con.ctype = nl+T1CHAR;
				con.cival = cp[0];
				con.crval = con.cival;
				break;
			}
			con.ctype = nl+TSTR;
			con.cpval = cp;
			break;
	}
	if (sgnd) {
		if (isnta(con.ctype, "id")) {
			derror("%s constants cannot be signed", nameof(con.ctype));
			return FALSE;
		} else if (negd)
			con.crval = -con.crval;
	}
	return TRUE;
}