func.c

早期freebsd实现

	return itoq((long) qissquare(vp));
}


static NUMBER *
f_primetest(val1, val2)
	NUMBER *val1, *val2;
{
	return itoq((long) qprimetest(val1, val2));
}


static NUMBER *
f_isset(val1, val2)
	NUMBER *val1, *val2;
{
	if (qisfrac(val2))
		math_error("Non-integral bit position");
	if (qiszero(val1) || (qisint(val1) && qisneg(val2)))
		return qlink(&_qzero_);
	if (zisbig(val2->num)) {
		if (qisneg(val2))
			math_error("Very large bit position");
		return qlink(&_qzero_);
	}
	return itoq((long) qisset(val1, qtoi(val2)));
}


static NUMBER *
f_digit(val1, val2)
	NUMBER *val1, *val2;
{
	if (qisfrac(val2))
		math_error("Non-integral digit position");
	if (qiszero(val1) || (qisint(val1) && qisneg(val2)))
		return qlink(&_qzero_);
	if (zisbig(val2->num)) {
		if (qisneg(val2))
			math_error("Very large digit position");
		return qlink(&_qzero_);
	}
	return itoq((long) qdigit(val1, qtoi(val2)));
}


static NUMBER *
f_digits(val)
	NUMBER *val;
{
	return itoq((long) qdigits(val));
}


static NUMBER *
f_places(val)
	NUMBER *val;
{
	return itoq((long) qplaces(val));
}


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

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


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

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


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

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


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

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


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

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


static VALUE
f_hash(count, vals)
	int count;
	VALUE **vals;
{
	HASH hash;
	long lhash;
	VALUE result;

	hash = 0;
	while (count-- > 0)
		hash = hash * 947369 + hashvalue(*vals++);
	lhash = (long) hash;
	if (lhash < 0)
		lhash = -lhash;
	if (lhash < 0)
		lhash = 0;
	result.v_num = itoq(lhash);
	result.v_type = V_NUM;
	return result;
}


static VALUE
f_avg(count, vals)
	int count;
	VALUE **vals;
{
	int i;
	VALUE result;
	VALUE tmp;
	VALUE div;

	result.v_num = qlink(&_qzero_);
	result.v_type = V_NUM;
	for (i = count; i > 0; i--) {
		addvalue(&result, *vals++, &tmp);
		freevalue(&result);
		result = tmp;
	}
	if (count <= 1)
		return result;
	div.v_num = itoq((long) count);
	div.v_type = V_NUM;
	divvalue(&result, &div, &tmp);
	qfree(div.v_num);
	return tmp;
}


static NUMBER *
f_hmean(count, vals)
	int count;
	NUMBER **vals;
{
	NUMBER *val, *tmp, *tmp2, *num;

	num = itoq(count);
	val = qinv(*vals);
	while (--count > 0) {
		tmp2 = qinv(*++vals);
		tmp = qadd(val, tmp2);
		qfree(tmp2);
		qfree(val);
		val = tmp;
	}
	tmp = qdiv(num, val);
	qfree(num);
	qfree(val);
	return tmp;
}


static VALUE
f_ssq(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result, tmp1, tmp2;

	squarevalue(*vals++, &result);
	while (--count > 0) {
		squarevalue(*vals++, &tmp1);
		addvalue(&tmp1, &result, &tmp2);
		freevalue(&tmp1);
		freevalue(&result);
		result = tmp2;
	}
	return result;
}


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


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

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


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

	err = _epsilon_;
	if (count == 2) {
		if (vals[1]->v_type != V_NUM)
			math_error("Non-real epsilon value for exp");
		err = vals[1]->v_num;
	}
	switch (vals[0]->v_type) {
		case V_NUM:
			result.v_num = qexp(vals[0]->v_num, err);
			result.v_type = V_NUM;
			break;
		case V_COM:
			result.v_com = cexp(vals[0]->v_com, err);
			result.v_type = V_COM;
			break;
		default:
			math_error("Bad argument type for exp");
	}
	return result;
}


static VALUE
f_ln(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;
	COMPLEX ctmp;
	NUMBER *err;

	err = _epsilon_;
	if (count == 2) {
		if (vals[1]->v_type != V_NUM)
			math_error("Non-real epsilon value for ln");
		err = vals[1]->v_num;
	}
	switch (vals[0]->v_type) {
		case V_NUM:
			if (!qisneg(vals[0]->v_num) && !qiszero(vals[0]->v_num)) {
				result.v_num = qln(vals[0]->v_num, err);
				result.v_type = V_NUM;
				break;
			}
			ctmp.real = vals[0]->v_num;
			ctmp.imag = &_qzero_;
			ctmp.links = 1;
			result.v_com = cln(&ctmp, err);
			result.v_type = V_COM;
			break;
		case V_COM:
			result.v_com = cln(vals[0]->v_com, err);
			result.v_type = V_COM;
			break;
		default:
			math_error("Bad argument type for ln");
	}
	return result;
}


static VALUE
f_cos(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;
	COMPLEX *c;
	NUMBER *err;

	err = _epsilon_;
	if (count == 2) {
		if (vals[1]->v_type != V_NUM)
			math_error("Non-real epsilon value for cos");
		err = vals[1]->v_num;
	}
	switch (vals[0]->v_type) {
		case V_NUM:
			result.v_num = qcos(vals[0]->v_num, err);
			result.v_type = V_NUM;
			break;
		case V_COM:
			c = ccos(vals[0]->v_com, err);
			result.v_com = c;
			result.v_type = V_COM;
			if (cisreal(c)) {
				result.v_num = qlink(c->real);
				result.v_type = V_NUM;
				comfree(c);
			}
			break;
		default:
			math_error("Bad argument type for cos");
	}
	return result;
}


static VALUE
f_sin(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;
	COMPLEX *c;
	NUMBER *err;

	err = _epsilon_;
	if (count == 2) {
		if (vals[1]->v_type != V_NUM)
			math_error("Non-real epsilon value for sin");
		err = vals[1]->v_num;
	}
	switch (vals[0]->v_type) {
		case V_NUM:
			result.v_num = qsin(vals[0]->v_num, err);
			result.v_type = V_NUM;
			break;
		case V_COM:
			c = csin(vals[0]->v_com, err);
			result.v_com = c;
			result.v_type = V_COM;
			if (cisreal(c)) {
				result.v_num = qlink(c->real);
				result.v_type = V_NUM;
				comfree(c);
			}
			break;
		default:
			math_error("Bad argument type for sin");
	}
	return result;
}


static VALUE
f_arg(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;
	COMPLEX *c;
	NUMBER *err;

	err = _epsilon_;
	if (count == 2) {
		if (vals[1]->v_type != V_NUM)
			math_error("Non-real epsilon value for arg");
		err = vals[1]->v_num;
	}
	result.v_type = V_NUM;
	switch (vals[0]->v_type) {
		case V_NUM:
			if (qisneg(vals[0]->v_num))
				result.v_num = qpi(err);
			else
				result.v_num = qlink(&_qzero_);
			break;
		case V_COM:
			c = vals[0]->v_com;
			if (ciszero(c))
				result.v_num = qlink(&_qzero_);
			else
				result.v_num = qatan2(c->imag, c->real, err);
			break;
		default:
			math_error("Bad argument type for arg");
	}
	return result;
}


static NUMBER *
f_legtoleg(val1, val2)
	NUMBER *val1, *val2;
{
	return qlegtoleg(val1, val2, FALSE);
}


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

	val = &_qzero_;
	if (count == 2)
		val = vals[1];
	return qtrunc(*vals, val);
}


static VALUE
f_bround(count, vals)
	int count;
	VALUE **vals;
{
	VALUE *vp, tmp, res;

	if (count > 1)
		vp = vals[1];
	else {
		tmp.v_type = V_INT;
		tmp.v_num = 0;
		vp = &tmp;
	}
	broundvalue(vals[0], vp, &res);
	return res;
}


static VALUE
f_round(count, vals)
	int count;
	VALUE **vals;
{
	VALUE *vp, tmp, res;

	if (count > 1)
		vp = vals[1];
	else {
		tmp.v_type = V_INT;
		tmp.v_num = 0;
		vp = &tmp;
	}
	roundvalue(vals[0], vp, &res);
	return res;
}


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

	val = &_qzero_;
	if (count == 2)
		val = vals[1];
	return qbtrunc(*vals, val);
}


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

	val = _epsilon_;
	if (count == 3)
		val = vals[2];
	return itoq((long) qnear(vals[0], vals[1], val));
}


static NUMBER *
f_cfsim(val)
	NUMBER *val;
{
	return qcfappr(val, NULL);
}


static NUMBER *
f_ceil(val)
	NUMBER *val;