func.c

Calc Software Package for Number Calc

		if (places == -2)
			return error_value(E_PLCS2);
	} else
		places = qdecplaces(vals[0]->v_num);

	res.v_type = V_NUM;
	res.v_num = itoq(places);
	return res;
}


static NUMBER *
f_popcnt(int count, NUMBER **vals)
{
	int bitval = 1;

	/*
	 * parse args
	 */
	if (count == 2 && qiszero(vals[1])) {
		bitval = 0;
	}

	/*
	 * count bit values
	 */
	if (qisint(vals[0])) {
		return itoq(zpopcnt(vals[0]->num, bitval));
	} else {
		return itoq(zpopcnt(vals[0]->num, bitval) +
			    zpopcnt(vals[0]->den, bitval));
	}
}


static VALUE
f_xor(int count, VALUE **vals)
{
	NUMBER *q, *qtmp;
	STRING *s, *stmp;
	VALUE result;
	int i;
	int type;

	type = vals[0]->v_type;
	result.v_type = type;
	result.v_subtype = vals[0]->v_subtype;
	for (i = 1; i < count; i++) {
		if (vals[i]->v_type != type)
			return error_value(E_XOR1);
	}
	switch (type) {
		case V_NUM:
			q = qlink(vals[0]->v_num);
			for (i = 1; i < count; i++) {
				qtmp = qxor(q, vals[i]->v_num);
				qfree(q);
				q = qtmp;
			}
			result.v_num = q;
			break;
		case V_STR:
			s = slink(vals[0]->v_str);
			for (i = 1; i < count; i++) {
				stmp = stringxor(s, vals[i]->v_str);
				sfree(s);
				s = stmp;
			}
			result.v_str = s;
			break;
		default:
			return error_value(E_XOR2);
	}
	return result;
}


VALUE
minlistitems(LIST *lp)
{
	LISTELEM *ep;
	VALUE *vp;
	VALUE term;
	VALUE rel;
	VALUE min;

	/* initialize VALUEs */
	min.v_type = V_NULL;
	min.v_subtype = V_NOSUBTYPE;
	term.v_type = V_NULL;
	term.v_subtype = V_NOSUBTYPE;

	for (ep = lp->l_first; ep; ep = ep->e_next) {
		vp = &ep->e_value;
		switch(vp->v_type) {
			case V_LIST:
				term = minlistitems(vp->v_list);
				break;
			case V_OBJ:
				term = objcall(OBJ_MIN, vp,
					       NULL_VALUE, NULL_VALUE);
				break;
			default:
				copyvalue(vp, &term);
		}
		if (min.v_type == V_NULL) {
			min = term;
			continue;
		}
		if (term.v_type == V_NULL)
			continue;
		relvalue(&term, &min, &rel);
		if (rel.v_type != V_NUM) {
			freevalue(&term);
			freevalue(&min);
			freevalue(&rel);
			return error_value(E_LISTMIN);
		}
		if (qisneg(rel.v_num)) {
			freevalue(&min);
			min = term;
		}
		else
			freevalue(&term);
		freevalue(&rel);
	}
	return min;
}


VALUE
maxlistitems(LIST *lp)
{
	LISTELEM *ep;
	VALUE *vp;
	VALUE term;
	VALUE rel;
	VALUE max;

	/* initialize VALUEs */
	max.v_type = V_NULL;
	max.v_subtype = V_NOSUBTYPE;
	term.v_type = V_NULL;
	term.v_subtype = V_NOSUBTYPE;

	for (ep = lp->l_first; ep; ep = ep->e_next) {
		vp = &ep->e_value;
		switch(vp->v_type) {
			case V_LIST:
				term = maxlistitems(vp->v_list);
				break;
			case V_OBJ:
				term = objcall(OBJ_MAX, vp,
					       NULL_VALUE, NULL_VALUE);
				break;
			default:
				copyvalue(vp, &term);
		}
		if (max.v_type == V_NULL) {
			max = term;
			continue;
		}
		if (term.v_type == V_NULL)
			continue;
		relvalue(&max, &term, &rel);
		if (rel.v_type != V_NUM) {
			freevalue(&max);
			freevalue(&term);
			freevalue(&rel);
			return error_value(E_LISTMAX);
		}
		if (qisneg(rel.v_num)) {
			freevalue(&max);
			max = term;
		}
		else
			freevalue(&term);
		freevalue(&rel);
	}
	return max;
}


static VALUE
f_min(int count, VALUE **vals)
{
	VALUE min;
	VALUE term;
	VALUE *vp;
	VALUE rel;

	/* initialize VALUEs */
	min.v_type = V_NULL;
	min.v_subtype = V_NOSUBTYPE;
	term.v_type = V_NULL;
	term.v_subtype = V_NOSUBTYPE;

	while (count-- > 0) {
		vp = *vals++;
		switch(vp->v_type) {
			case V_LIST:
				term = minlistitems(vp->v_list);
				break;
			case V_OBJ:
				term = objcall(OBJ_MIN, vp,
					      NULL_VALUE, NULL_VALUE);
				break;
			default:
				copyvalue(vp, &term);
		}
		if (min.v_type == V_NULL) {
			min = term;
			continue;
		}
		if (term.v_type == V_NULL)
			continue;
		if (term.v_type < 0) {
			freevalue(&min);
			return term;
		}
		relvalue(&term, &min, &rel);
		if (rel.v_type != V_NUM) {
			freevalue(&min);
			freevalue(&term);
			freevalue(&rel);
			return error_value(E_MIN);
		}
		if (qisneg(rel.v_num)) {
			freevalue(&min);
			min = term;
		} else {
			freevalue(&term);
		}
		freevalue(&rel);
	}
	return min;
}


static VALUE
f_max(int count, VALUE **vals)
{
	VALUE max;
	VALUE term;
	VALUE *vp;
	VALUE rel;

	/* initialize VALUEs */
	max.v_type = V_NULL;
	max.v_subtype = V_NOSUBTYPE;
	term.v_type = V_NULL;
	term.v_subtype = V_NOSUBTYPE;

	while (count-- > 0) {
		vp = *vals++;
		switch(vp->v_type) {
			case V_LIST:
				term = maxlistitems(vp->v_list);
				break;
			case V_OBJ:
				term = objcall(OBJ_MAX, vp,
					       NULL_VALUE, NULL_VALUE);
				break;
			default:
				copyvalue(vp, &term);
		}
		if (max.v_type == V_NULL) {
			max = term;
			continue;
		}
		if (term.v_type == V_NULL)
			continue;
		if (term.v_type < 0) {
			freevalue(&max);
			return term;
		}
		relvalue(&max, &term, &rel);
		if (rel.v_type != V_NUM) {
			freevalue(&max);
			freevalue(&term);
			freevalue(&rel);
			return error_value(E_MAX);
		}
		if (qisneg(rel.v_num)) {
			freevalue(&max);
			max = term;
		} else {
			freevalue(&term);
		}
		freevalue(&rel);
	}
	return max;
}


static NUMBER *
f_gcd(int count, NUMBER **vals)
{
	NUMBER *val, *tmp;

	val = qqabs(*vals);
	while (--count > 0) {
		tmp = qgcd(val, *++vals);
		qfree(val);
		val = tmp;
	}
	return val;
}


static NUMBER *
f_lcm(int count, NUMBER **vals)
{
	NUMBER *val, *tmp;

	val = qqabs(*vals);
	while (--count > 0) {
		tmp = qlcm(val, *++vals);
		qfree(val);
		val = tmp;
		if (qiszero(val))
			break;
	}
	return val;
}


static VALUE
f_hash(int count, VALUE **vals)
{
	QCKHASH hash;
	VALUE result;

	/* initialize VALUE */
	result.v_type = V_NUM;
	result.v_subtype = V_NOSUBTYPE;

	hash = FNV1_32_BASIS;
	while (count-- > 0)
		hash = hashvalue(*vals++, hash);
	result.v_num = utoq((FULL) hash);
	return result;
}


VALUE
sumlistitems(LIST *lp)
{
	LISTELEM *ep;
	VALUE *vp;
	VALUE term;
	VALUE tmp;
	VALUE sum;

	/* initialize VALUEs */
	term.v_type = V_NULL;
	term.v_subtype = V_NOSUBTYPE;
	tmp.v_type = V_NULL;
	tmp.v_subtype = V_NOSUBTYPE;
	sum.v_type = V_NULL;
	sum.v_subtype = V_NOSUBTYPE;

	for (ep = lp->l_first; ep; ep = ep->e_next) {
		vp = &ep->e_value;
		switch(vp->v_type) {
			case V_LIST:
				term = sumlistitems(vp->v_list);
				break;
			case V_OBJ:
				term = objcall(OBJ_SUM, vp,
					       NULL_VALUE, NULL_VALUE);
				break;
			default:
				addvalue(&sum, vp, &tmp);
				freevalue(&sum);
				if (tmp.v_type < 0)
					return tmp;
				sum = tmp;
				continue;
		}
		addvalue(&sum, &term, &tmp);
		freevalue(&sum);
		freevalue(&term);
		sum = tmp;
		if (sum.v_type < 0)
			break;
	}
	return sum;
}


static VALUE
f_sum(int count, VALUE **vals)
{
	VALUE tmp;
	VALUE sum;
	VALUE term;
	VALUE *vp;

	/* initialize VALUEs */
	tmp.v_type = V_NULL;
	tmp.v_subtype = V_NOSUBTYPE;
	sum.v_type = V_NULL;
	sum.v_subtype = V_NOSUBTYPE;
	term.v_type = V_NULL;
	term.v_subtype = V_NOSUBTYPE;
	while (count-- > 0) {
		vp = *vals++;
		switch(vp->v_type) {
			case V_LIST:
				term = sumlistitems(vp->v_list);
				break;
			case V_OBJ:
				term = objcall(OBJ_SUM, vp,
					      NULL_VALUE, NULL_VALUE);
				break;
			default:
				addvalue(&sum, vp, &tmp);
				freevalue(&sum);
				if (tmp.v_type < 0)
					return tmp;
				sum = tmp;
				continue;
		}
		addvalue(&sum, &term, &tmp);
		freevalue(&term);
		freevalue(&sum);
		sum = tmp;
		if (sum.v_type < 0)
			break;
	}
	return sum;
}


static VALUE
f_avg(int count, VALUE **vals)
{
	VALUE tmp;
	VALUE sum;
	VALUE div;
	long n;

	/* initialize VALUEs */
	tmp.v_type = V_NULL;
	tmp.v_subtype = V_NOSUBTYPE;
	sum.v_type = V_NULL;
	sum.v_subtype = V_NOSUBTYPE;
	div.v_type = V_NULL;
	div.v_subtype = V_NOSUBTYPE;

	n = 0;
	while (count-- > 0) {
		if ((*vals)->v_type == V_LIST) {
			addlistitems((*vals)->v_list, &sum);
			n += countlistitems((*vals++)->v_list);
		} else {
			addvalue(&sum, *vals++, &tmp);
			freevalue(&sum);
			sum = tmp;
			n++;
		}
		if (sum.v_type < 0)
			return sum;
	}
	if (n < 2)
		return sum;
	div.v_num = itoq(n);
	div.v_type = V_NUM;
	div.v_subtype = V_NOSUBTYPE;
	divvalue(&sum, &div, &tmp);
	freevalue(&sum);
	qfree(div.v_num);
	return tmp;
}


static VALUE
f_fact(VALUE *vp)
{
	VALUE res;

	/* initialize VALUE */
	res.v_type = V_NUM;
	res.v_subtype = V_NOSUBTYPE;

	if (vp->v_type == V_OBJ) {
		return objcall(OBJ_FACT, vp, NULL_VALUE, NULL_VALUE);
	}
	if (vp->v_type != V_NUM) {
		math_error("Non-real argument for fact()");
		/*NOTREACHED*/
	}
	res.v_num = qfact(vp->v_num);
	return res;
}


static VALUE
f_hmean(int count, VALUE **vals)
{
	VALUE sum, tmp1, tmp2;
	long n = 0;

	/* initialize VALUEs */
	sum.v_type = V_NULL;
	sum.v_subtype = V_NOSUBTYPE;
	tmp1.v_type = V_NULL;
	tmp1.v_subtype = V_NOSUBTYPE;
	tmp2.v_type = V_NULL;
	tmp2.v_subtype = V_NOSUBTYPE;

	while (count-- > 0) {
		if ((*vals)->v_type == V_LIST) {
			addlistinv((*vals)->v_list, &sum);
			n += countlistitems((*vals++)->v_list);
		} else {
			invertvalue(*vals++, &tmp1);
			addvalue(&sum, &tmp1, &tmp2);
			freevalue(&tmp1);
			freevalue(&sum);
			sum = tmp2;
			n++;
		}
	}
	if (n == 0)
		return sum;
	tmp1.v_type = V_NUM;
	tmp1.v_subtype = V_NOSUBTYPE;
	tmp1.v_num = itoq(n);
	divvalue(&tmp1, &sum, &tmp2);
	qfree(tmp1.v_num);
	freevalue(&sum);
	return tmp2;
}


static NUMBER *
f_hnrmod(NUMBER *val1, NUMBER *val2, NUMBER *val3, NUMBER *val4)
{
	ZVALUE answer;			/* v mod h*2^n+r */
	NUMBER *res;			/* v mod h*2^n+r */

	/*
	 * firewall
	 */
	if (qisfrac(val1)) {
		math_error("1st arg of hnrmod (v) must be an integer");
		/*NOTREACHED*/
	}
	if (qisfrac(val2) || qisneg(val2) || qiszero(val2)) {
		math_error("2nd arg of hnrmod (h) must be an integer > 0");
		/*NOTREACHED*/
	}
	if (qisfrac(val3) || qisneg(val3) || qiszero(val3)) {
		math_error("3rd arg of hnrmod (n) must be an integer > 0");
		/*NOTREACHED*/
	}
	if (qisfrac(val4) || !zisabsleone(val4->num)) {
		math_error("4th arg of hnrmod (r) must be -1, 0 or 1");
		/*NOTREACHED*/
	}

	/*
	 * perform the val1 mod (val2 * 2^val3 + val4) operation
	 */
	zhnrmod(val1->num, val2->num, val3->num, val4->num, &answer);

	/*
	 * return the answer
	 */
	res = qalloc();
	res->num = answer;
	return res;
}

VALUE
ssqlistitems(LIST *lp)
{
	LISTELEM *ep;
	VALUE *vp;
	VALUE term;
	VALUE tmp;
	VALUE sum;

	/* initialize VALUEs */
	term.v_type = V_NULL;
	term.v_subtype = V_NOSUBTYPE;
	tmp.v_type = V_NULL;
	tmp.v_subtype = V_NOSUBTYPE;
	sum.v_type = V_NULL;
	sum.v_subtype = V_NOSUBTYPE;

	for (ep = lp->l_first; ep; ep = ep->e_next) {
		vp = &ep->e_value;
		if (vp->v_type == V_LIST) {
			term = ssqlistitems(vp->v_list);
		} else {
			squarevalue(vp, &term);
		}
		addvalue(&sum, &term, &tmp);
		freevalue(&sum);
		freevalue(&term);
		sum = tmp;
		if (sum.v_type < 0)
			break;
	}
	return sum;
}

static VALUE
f_ssq(int count, VALUE **vals)
{
	VALUE tmp;
	VALUE sum;
	VALUE term;
	VALUE *vp;

	/* initialize VALUEs */
	tmp.v_type = V_NULL;
	tmp.v_subtype = V_NOSUBTYPE;
	sum.v_type = V_NULL;
	sum.v_subtype = V_NOSUBTYPE;
	term.v_type = V_NULL;
	term.v_subtype = V_NOSUBTYPE;
	while (count-- > 0) {
		vp = *vals++;
		if (vp->v_type == V_LIST) {
			term = ssqlistitems(vp->v_list);
		} else {
			squarevalue(vp, &term);
		}
		addvalue(&sum, &term, &tmp);
		freevalue(&term);
		freevalue(&sum);
		sum = tmp;
		if (sum.v_type < 0)
			break;
	}
	return sum;
}


static NUMBER *
f_ismult(NUMBER *val1, NUMBER *val2)
{
	return itoq((long) qdivides(val1, val2));
}


static NUMBER *
f_meq(NUMBER *val1, NUMBER *val2, NUMBER *val3)
{
	NUMBER *tmp, *res;

	tmp = qsub(val1, val2);
	res = itoq((long) qdivides(tmp, val3));
	qfree(tmp);
	return res;
}


static VALUE
f_exp(int count, VALUE **vals)
{
	VALUE result;
	NUMBER *eps;