value.c

Calc Software Package for Number Calc

		return;
	}
	vres->v_type = v1->v_type;
	switch (TWOVAL(v1->v_type, v2->v_type)) {
	case TWOVAL(V_NUM, V_NUM):
		vres->v_num = qand(v1->v_num, v2->v_num);
		return;
	case TWOVAL(V_STR, V_STR):
		vres->v_str = stringand(v1->v_str, v2->v_str);
		if (vres->v_str == NULL)
			*vres = error_value(E_STRAND);
		return;
	case TWOVAL(V_OCTET, V_OCTET):
		vres->v_type = V_STR;
		vres->v_str = charstring(*v1->v_octet & *v2->v_octet);
		return;
	case TWOVAL(V_STR, V_OCTET):
		vres->v_str = charstring(*v1->v_str->s_str &
					*v2->v_octet);
		return;
	case TWOVAL(V_OCTET, V_STR):
		vres->v_type = V_STR;
		vres->v_str = charstring(*v1->v_octet &
					*v2->v_str->s_str);
		return;
	default:
		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
			if (v1->v_type < 0)
				return;
			if (v2->v_type < 0) {
				vres->v_type = v2->v_type;
				return;
			}
			*vres = error_value(E_AND);
			return;
		}
		*vres = objcall(OBJ_AND, v1, v2, NULL_VALUE);
		return;
	}
}


/*
 * "OR" two arbitrary values together.
 * Result is placed in the indicated location.
 */
void
orvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
	if (v1->v_type == V_NULL) {
		copyvalue(v2, vres);
		return;
	}
	if (v2->v_type == V_NULL) {
		copyvalue(v1, vres);
		return;
	}
	vres->v_type = v1->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (TWOVAL(v1->v_type, v2->v_type)) {
	case TWOVAL(V_NUM, V_NUM):
		vres->v_num = qor(v1->v_num, v2->v_num);
		return;
	case TWOVAL(V_STR, V_STR):
		vres->v_str = stringor(v1->v_str, v2->v_str);
		if (vres->v_str == NULL)
			*vres = error_value(E_STROR);
		return;
	case TWOVAL(V_OCTET, V_OCTET):
		vres->v_type = V_STR;
		vres->v_str = charstring(*v1->v_octet | *v2->v_octet);
		return;
	case TWOVAL(V_STR, V_OCTET):
		vres->v_str = charstring(*v1->v_str->s_str |
				*v2->v_octet);
		return;
	case TWOVAL(V_OCTET, V_STR):
		vres->v_type = V_STR;
		vres->v_str = charstring(*v1->v_octet |
				*v2->v_str->s_str);
		return;
	default:
		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
			if (v1->v_type < 0)
				return;
			if (v2->v_type < 0) {
				vres->v_type = v2->v_type;
				return;
			}
			*vres = error_value(E_OR);
			return;
		}
		*vres = objcall(OBJ_OR, v1, v2, NULL_VALUE);
		return;
	}
}


/*
 * "~" two values, returns the "symmetric difference" bitwise xor(v1, v2) for
 * strings, octets and real numbers, and a user-defined function if at least
 * one of v1 and v2 is an object.
 */
void
xorvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
	vres->v_type = v1->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (TWOVAL(v1->v_type, v2->v_type)) {
	case (TWOVAL(V_NUM, V_NUM)):
		vres->v_num = qxor(v1->v_num, v2->v_num);
		return;
	case (TWOVAL(V_STR, V_STR)):
		vres->v_str = stringxor(v1->v_str, v2->v_str);
		if (vres->v_str == NULL)
			*vres = error_value(E_STRDIFF);
		return;
	case (TWOVAL(V_STR, V_OCTET)):
		if (v1->v_str->s_len) {
			vres->v_str = stringcopy(v1->v_str);
			*vres->v_str->s_str ^= *v2->v_octet;
		} else {
			vres->v_str = charstring(*v2->v_octet);
		}
		return;
	case (TWOVAL(V_OCTET, V_STR)):
		if (v2->v_str->s_len) {
			vres->v_str = stringcopy(v2->v_str);
			*vres->v_str->s_str ^= *v1->v_octet;
		} else {
			vres->v_str = charstring(*v1->v_octet);
		}
		return;
	case (TWOVAL(V_OCTET, V_OCTET)):
		vres->v_type = V_STR;
		vres->v_str = charstring(*v1->v_octet ^ *v2->v_octet);
		return;
	default:
		if (v1->v_type == V_OBJ || v2->v_type == V_OBJ)
			*vres = objcall(OBJ_XOR, v1, v2, NULL_VALUE);
		else
			*vres = error_value(E_XOR);
	}
}


/*
 * "#" two values - abs(v1-v2) for numbers, user-defined for objects
 */
void
hashopvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
	NUMBER *q;

	vres->v_type = v1->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (TWOVAL(v1->v_type, v2->v_type)) {
	case TWOVAL(V_NUM, V_NUM):
		q = qsub(v1->v_num, v2->v_num);
		vres->v_num = qqabs(q);
		qfree(q);
		return;
	default:
		if (v1->v_type == V_OBJ || v2->v_type == V_OBJ)
			*vres = objcall(OBJ_HASHOP, v1, v2, NULL_VALUE);
		else
			*vres = error_value(E_HASHOP);
	}
}


void
compvalue(VALUE *vp, VALUE *vres)
{

	vres->v_type = vp->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (vp->v_type) {
	case V_NUM:
		vres->v_num = qcomp(vp->v_num);
		return;
	case V_STR:
		vres->v_str = stringcomp(vp->v_str);
		if (vres->v_str == NULL)
			*vres = error_value(E_STRCOMP);
		return;
	case V_OCTET:
		vres->v_type = V_STR;
		vres->v_str = charstring(~*vp->v_octet);
		return;
	case V_OBJ:
		*vres = objcall(OBJ_COMP, vp, NULL_VALUE, NULL_VALUE);
		return;
	default:
		*vres = error_value(E_COMP);
	}
}

/*
 * "\" a value, user-defined only
 */
void
backslashvalue(VALUE *vp, VALUE *vres)
{
	if (vp->v_type == V_OBJ)
		*vres = objcall(OBJ_BACKSLASH, vp, NULL_VALUE, NULL_VALUE);
	else
		*vres = error_value(E_BACKSLASH);
}


/*
 * "\" two values, for strings performs bitwise "AND-NOT" operation
 * User defined for objects
 */
void
setminusvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
	vres->v_type = v1->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (TWOVAL(v1->v_type, v2->v_type)) {
	case TWOVAL(V_NUM, V_NUM):
		vres->v_num = qandnot(v1->v_num, v2->v_num);
		return;
	case TWOVAL(V_STR, V_STR):
		vres->v_str = stringdiff(v1->v_str, v2->v_str);
		return;
	case TWOVAL(V_STR, V_OCTET):
		vres->v_str = charstring(*v1->v_str->s_str &
			~*v2->v_octet);
		return;
	case TWOVAL(V_OCTET, V_STR):
		vres->v_type = V_STR;
		vres->v_str = charstring(*v1->v_octet &
			~*v2->v_str->s_str);
		return;
	case TWOVAL(V_OCTET, V_OCTET):
		vres->v_type = V_STR;
		vres->v_str = charstring(*v1->v_octet &
			~*v2->v_octet);
		return;
	default:
		if (v1->v_type == V_OBJ || v2->v_type == V_OBJ)
			*vres = objcall(OBJ_SETMINUS, v1, v2,
				NULL_VALUE);
		else
			*vres = error_value(E_SETMINUS);
	}
}


/*
 * "#" a value, for strings and octets returns the number of nonzero bits
 * in the value; user-defined for an object
 */
void
contentvalue(VALUE *vp, VALUE *vres)
{
	long count;
	unsigned char u;

	vres->v_type = V_NUM;
	vres->v_subtype = V_NOSUBTYPE;
	count = 0;
	switch (vp->v_type) {
	case V_STR:
		count = stringcontent(vp->v_str);
		break;
	case V_OCTET:
		for (u = *vp->v_octet; u; u >>= 1)
			count += (u & 1);
		break;
	case V_NUM:
		count = zpopcnt(vp->v_num->num, 1);
		break;
	case V_OBJ:
		*vres = objcall(OBJ_CONTENT, vp, NULL_VALUE,
			NULL_VALUE);
		return;
	default:
		*vres = error_value(E_CONTENT);
		return;
	}
	vres->v_num = itoq(count);
}


/*
 * Approximate numbers by multiples of v2 using rounding criterion v3.
 * Result is placed in the indicated location.
 */
void
apprvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
	NUMBER *e;
	long R = 0;
	NUMBER *q1, *q2;
	COMPLEX *c;

	vres->v_type = v1->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	if (v1->v_type <= 0)
		return;

	e = NULL;
	switch(v2->v_type) {
	case V_NUM:	e = v2->v_num;
			break;
	case V_NULL:	e = conf->epsilon;
			break;
	default:
		*vres = error_value(E_APPR2);
		return;
	}
	switch(v3->v_type) {
	case V_NUM:	if (qisfrac(v3->v_num)) {
				*vres = error_value(E_APPR3);
				return;
			}
			R = qtoi(v3->v_num);
			break;
	case V_NULL:	R = conf->appr;
			break;
	default:
		*vres = error_value(E_APPR3);
		return;
	}

	if (qiszero(e)) {
		copyvalue(v1, vres);
		return;
	}
	switch (v1->v_type) {
	case V_NUM:
		vres->v_num = qmappr(v1->v_num, e, R);
		return;
	case V_MAT:
		vres->v_mat = matappr(v1->v_mat, v2, v3);
		return;
	case V_LIST:
		vres->v_list = listappr(v1->v_list, v2, v3);
		return;
	case V_COM:
		q1 = qmappr(v1->v_com->real, e, R);
		q2 = qmappr(v1->v_com->imag, e, R);
		if (qiszero(q2)) {
			vres->v_type = V_NUM;
			vres->v_num = q1;
			qfree(q2);
			return;
		}
		c = comalloc();
		qfree(c->real);
		qfree(c->imag);
		c->real = q1;
		c->imag = q2;
		vres->v_com = c;
		return;
	default:
		*vres = error_value(E_APPR);
		return;
	}
}


/*
 * Round numbers to number of decimals specified by v2, type of rounding
 * specified by v3.  Result placed in location vres.
 */
void
roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
	NUMBER *q1, *q2;
	COMPLEX *c;
	long places, rnd;

	vres->v_type = v1->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	if (v1->v_type == V_MAT) {
		vres->v_mat = matround(v1->v_mat, v2, v3);
		return;
	}
	if (v1->v_type == V_LIST) {
		vres->v_list = listround(v1->v_list, v2, v3);
		return;
	}
	if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
		*vres = objcall(OBJ_ROUND, v1, v2, v3);
		return;
	}
	places = 0;
	switch (v2->v_type) {
	case V_NUM:
		if (qisfrac(v2->v_num)) {
			*vres = error_value(E_ROUND2);
			return;
		}
		places = qtoi(v2->v_num);
		break;
	case V_NULL:
		break;
	default:
		*vres = error_value(E_ROUND2);
		return;
	}
	rnd = 0;
	switch (v3->v_type) {
	case V_NUM:
		if (qisfrac(v3->v_num)) {
			*vres = error_value(E_ROUND3);
			return;
		}
		rnd = qtoi(v3->v_num);
		break;
	case V_NULL:
		rnd = conf->round;
		break;
	default:
		*vres = error_value(E_ROUND3);
		return;
	}
	switch(v1->v_type) {
	case V_NUM:
		vres->v_num = qround(v1->v_num, places, rnd);
		return;
	case V_COM:
		q1 = qround(v1->v_com->real, places, rnd);
		q2 = qround(v1->v_com->imag, places, rnd);
		if (qiszero(q2)) {
			vres->v_type = V_NUM;
			vres->v_num = q1;
			qfree(q2);
			return;
		}
		c = comalloc();
		qfree(c->real);
		qfree(c->imag);
		c->real = q1;
		c->imag = q2;
		vres->v_com = c;
		return;
	default:
		if (v1->v_type <= 0)
			return;
		*vres = error_value(E_ROUND);
		return;
	}
}



/*
 * Round numbers to number of binary digits specified by v2, type of rounding
 * specified by v3.  Result placed in location vres.
 */
void
broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
{
	NUMBER *q1, *q2;
	COMPLEX *c;
	long places, rnd;

	vres->v_type = v1->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	if (v1->v_type == V_MAT) {
		vres->v_mat = matbround(v1->v_mat, v2, v3);
		return;
	}
	if (v1->v_type == V_LIST) {
		vres->v_list = listbround(v1->v_list, v2, v3);
		return;
	}
	if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
		*vres = objcall(OBJ_BROUND, v1, v2, v3);
		return;
	}
	places = 0;
	switch (v2->v_type) {
	case V_NUM:
		if (qisfrac(v2->v_num)) {
			*vres = error_value(E_BROUND2);
			return;
		}
		places = qtoi(v2->v_num);
		break;
	case V_NULL:
		break;
	default:
		*vres = error_value(E_BROUND2);
		return;
	}
	rnd = 0;
	switch (v3->v_type) {
	case V_NUM:
		if (qisfrac(v3->v_num)) {
			*vres = error_value(E_BROUND3);
			return;
		}
		rnd = qtoi(v3->v_num);
		break;
	case V_NULL:
		rnd = conf->round;
		break;
	default:
		*vres = error_value(E_BROUND3);
		return;
	}
	switch(v1->v_type) {
	case V_NUM:
		vres->v_num = qbround(v1->v_num, places, rnd);
		return;
	case V_COM:
		q1 = qbround(v1->v_com->real, places, rnd);
		q2 = qbround(v1->v_com->imag, places, rnd);
		if (qiszero(q2)) {
			vres->v_type = V_NUM;
			vres->v_num = q1;
			qfree(q2);
			return;
		}
		c = comalloc();
		qfree(c->real);
		qfree(c->imag);
		c->real = q1;
		c->imag = q2;
		vres->v_com = c;
		return;
	default:
		if (v1->v_type <= 0)
			return;
		*vres = error_value(E_BROUND);
		return;
	}
}

/*
 * Take the integer part of an arbitrary value.
 * Result is placed in the indicated location.
 */
void
intvalue(VALUE *vp, VALUE *vres)
{
	COMPLEX *c;

	vres->v_type = vp->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (vp->v_type) {
	case V_NUM:
		if (qisint(vp->v_num))
			vres->v_num = qlink(vp->v_num);
		else
			vres->v_num = qint(vp->v_num);
		return;
	case V_COM:
		if (cisint(vp->v_com)) {
			vres->v_com = clink(vp->v_com);
			return;
		}
		vres->v_com = c_int(vp->v_com);
		c = vres->v_com;
		if (cisreal(c)) {
			vres->v_num = qlink(c->real);
			vres->v_type = V_NUM;
			comfree(c);
		}
		return;
	case V_MAT:
		vres->v_mat = matint(vp->v_mat);
		return;
	case V_OBJ:
		*vres = objcall(OBJ_INT, vp, NULL_VALUE, NULL_VALUE);
		return;
	default:
		if (vp->v_type <= 0)
			return;
		*vres = error_value(E_INT);
		return;
	}
}


/*
 * Take the fractional part of an arbitrary value.
 * Result is placed in the indicated location.
 */
void
fracvalue(VALUE *vp, VALUE *vres)
{
	COMPLEX *c;

	vres->v_type = vp->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (vp->v_type) {
	case V_NUM:
		if (qisint(vp->v_num))
			vres->v_num = qlink(&_qzero_);
		else
			vres->v_num = qfrac(vp->v_num);
		return;
	case V_COM:
		if (cisint(vp->v_com)) {
			vres->v_num = clink(&_qzero_);
			vres->v_type = V_NUM;
			return;
		}
		vres->v_com = c_frac(vp->v_com);
		c = vres->v_com;
		if (cisreal(c)) {
			vres->v_num = qlink(c->real);
			vres->v_type = V_NUM;
			comfree(c);
		}
		return;
	case V_MAT:
		vres->v_mat = matfrac(vp->v_mat);
		return;
	case V_OBJ:
		*vres = objcall(OBJ_FRAC, vp, NULL_VALUE, NULL_VALUE);
		return;
	default:
		if (vp->v_type < 0)
			return;
		*vres = error_value(E_FRAC);
		return;
	}
}


/*
 * Increment an arbitrary value by one.
 * Result is placed in the indicated location.
 */
void
incvalue(VALUE *vp, VALUE *vres)
{
	vres->v_type = vp->v_type;
	switch (vp->v_type) {
	case V_NUM:
		vres->v_num = qinc(vp->v_num);
		break;
	case V_COM:
		vres->v_com = c_addq(vp->v_com, &_qone_);
		break;
	case V_OBJ:
		*vres = objcall(OBJ_INC, vp, NULL_VALUE, NULL_VALUE);
		break;
	case V_OCTET:
		*vres->v_octet = *vp->v_octet + 1;
		break;
	case V_OPTR:
		vres->v_octet = vp->v_octet + 1;
		break;
	case V_VPTR:
		vres->v_addr = vp->v_addr + 1;
		break;
	default:
		if (vp->v_type > 0)
			*vres = error_value(E_INCV);
		break;
	}
	vres->v_subtype = vp->v_subtype;
}


/*
 * Decrement an arbitrary value by one.
 * Result is placed in the indicated location.
 */
void
decvalue(VALUE *vp, VALUE *vres)
{
	vres->v_type = vp->v_type;
	switch (vp->v_type) {
	case V_NUM:
		vres->v_num = qdec(vp->v_num);
		break;
	case V_COM:
		vres->v_com = c_addq(vp->v_com, &_qnegone_);
		break;
	case V_OBJ:
		*vres = objcall(OBJ_DEC, vp, NULL_VALUE, NULL_VALUE);
		break;
	case V_OCTET:
		*vres->v_octet = *vp->v_octet - 1;
		break;
	case V_OPTR:
		vres->v_octet = vp->v_octet - 1;
		break;
	case V_VPTR:
		vres->v_addr = vp->v_addr - 1;
		break;
	default:
		if (vp->v_type >= 0)
			*vres = error_value(E_DECV);
		break;
	}
	vres->v_subtype = vp->v_subtype;
}


/*
 * Produce the 'conjugate' of an arbitrary value.
 * Result is placed in the indicated location.
 * (Example: complex conjugate.)
 */
void
conjvalue(VALUE *vp, VALUE *vres)
{
	vres->v_type = vp->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (vp->v_type) {
	case V_NUM:
		vres->v_num = qlink(vp->v_num);
		return;
	case V_COM:
		vres->v_com = comalloc();
		qfree(vres->v_com->real);
		qfree(vres->v_com->imag)
		vres->v_com->real = qlink(vp->v_com->real);
		vres->v_com->imag = qneg(vp->v_com->imag);
		return;
	case V_MAT:
		vres->v_mat = matconj(vp->v_mat);
		return;
	case V_OBJ:
		*vres = objcall(OBJ_CONJ, vp, NULL_VALUE, NULL_VALUE);
		return;
	default:
		if (vp->v_type <= 0) {
			vres->v_type = vp->v_type;
			return;