1BSD/pi/conv.c

#include "whoami"
#ifdef PI
#include "0.h"
#include "opcode.h"

/*
 * Convert a p1 into a p2.
 * Mostly used for different
 * length integers and "to real" conversions.
 */
convert(p1, p2)
	struct nl *p1, *p2;
{
	if (p1 == NIL || p2 == NIL)
		return;
	switch (width(p1) - width(p2)) {
		case -7:
		case -6:
			put1(O_STOD);
			return;
		case -4:
			put1(O_ITOD);
			return;
		case -3:
		case -2:
			put1(O_STOI);
			return;
		case -1:
		case 0:
		case 1:
			return;
		case 2:
		case 3:
			put1(O_ITOS);
			return;
		default:
			panic("convert");
	}
}

/*
 * Compat tells whether
 * p1 and p2 are compatible
 * types for an assignment like
 * context, i.e. value parameters,
 * indicies for 'in', etc.
 */
compat(p1, p2, t)
	struct nl *p1, *p2;
{
	register c1, c2;

	c1 = classify(p1);
	if (c1 == NIL)
		return (NIL);
	c2 = classify(p2);
	if (c2 == NIL)
		return (NIL);
	switch (c1) {
		case TBOOL:
		case TCHAR:
			if (c1 == c2)
				return (1);
			break;
		case TINT:
			if (c2 == TINT)
				return (1);
		case TDOUBLE:
			if (c2 == TDOUBLE)
				return (1);
			if (c2 == TINT && divflg == 0) {
				divchk= 1;
				c1 = classify(rvalue(t, NIL));
				divchk = NIL;
				if (c1 == TINT) {
					error("Type clash: real is incompatible with integer");
					cerror("This resulted because you used '/' which always returns real rather");
					cerror("than 'div' which divides integers and returns integers");
					divflg = 1;
					return (NIL);
				}
			}
			break;
		case TSCAL:
			if (c2 != TSCAL)
				break;
			if (scalar(p1) != scalar(p2)) {
				error("Type clash: non-identical scalar types");
				return (NIL);
			}
			return (1);
		case TSTR:
			if (c2 != TSTR)
				break;
			if (width(p1) != width(p2)) {
				error("Type clash: unequal length strings");
				return (NIL);
			}
			return (1);
		case TNIL:
			if (c2 != TPTR)
				break;
			return (1);
		case TFILE:
			if (c1 != c2)
				break;
			error("Type clash: files not allowed in this context");
			return (NIL);
		default:
			if (c1 != c2)
				break;
			if (p1 != p2) {
				error("Type clash: non-identical %s types", clnames[c1]);
				return (NIL);
			}
			if (p1->nl_flags & NFILES) {
				error("Type clash: %ss with file components not allowed in this context", clnames[c1]);
				return (NIL);
			}
			return (1);
	}
	error("Type clash: %s is incompatible with %s", clnames[c1], clnames[c2]);
	return (NIL);
}

/*
 * Rangechk generates code to
 * check if the type p on top
 * of the stack is in range for
 * assignment to a variable
 * of type q.
 */
rangechk(p, q)
	struct nl *p, *q;
{
	register struct nl *rp;
	register op;
	int wq, wrp;

	if (opt('t') == 0)
		return;
	rp = p;
	if (rp == NIL)
		return;
	if (q == NIL)
		return;
	/*
	 * When op is 1 we are checking length
	 * 4 numbers against length 2 bounds,
	 * and adding it to the opcode forces
	 * generation of appropriate tests.
	 */
	op = 0;
	wq = width(q);
	wrp = width(rp);
	op = wq != wrp && (wq == 4 || wrp == 4);
	if (rp->class == TYPE)
		rp = rp->type;
	switch (rp->class) {
		case RANGE:
			if (rp->range[0] != 0) {
				if (wrp <= 2)
					put3(O_RANG2+op, rp->value[1], rp->value[3]);
				else if (rp != nl+T4INT)
					put(5, O_RANG4+op, rp->range[0], rp->range[1]);
				break;
			}
			/*
			 * Range whose lower bounds are
			 * zero can be treated as scalars.
			 */
		case SCAL:
			if (wrp <= 2)
				put2(O_RSNG2+op, rp->value[3]);
			else
				put3(O_RSNG4+op, rp->range[1]);
			break;
		default:
			panic("rangechk");
	}
}
#endif