func.c

Calc Software Package for Number Calc

		/* no factor found - qalloc set factor to 1, return 1 */
		return factor;
	}

	/*
	 * return the factor found
	 */
	if (count < 2)
		zfree(limit);
	return factor;
}


static NUMBER *
f_pix(int count, NUMBER **vals)
{
	NUMBER *err;		/* error return, NULL => use math_error */
	long value;		/* primes <= x, or 0 ==> error */

	/* determine the way we report problems */
	if (count == 2) {
		if (qisfrac(vals[1])) {
			math_error("2nd pix arg must be an integer");
			/*NOTREACHED*/
		}
		err = vals[1];
	} else {
		err = NULL;
	}

	/* firewall - must be an integer */
	if (qisfrac(vals[0])) {
		if (err) {
			return qlink(err);
		}
		math_error("non-integral arg 1 for builtin function pix");
		/*NOTREACHED*/
	}

	/* determine the number of primes <= x */
	value = zpix(vals[0]->num);
	if (value >= 0) {
		return utoq(value);
	}

	/* error return */
	if (!err) {
		math_error("pix arg 1 is >= 2^32");
		/*NOTREACHED*/
	}
	return qlink(err);
}


static NUMBER *
f_prevcand(int count, NUMBER **vals)
{
	ZVALUE zmodulus;
	ZVALUE zresidue;
	ZVALUE zskip;
	ZVALUE *zcount = NULL;		/* ptest trial count */
	ZVALUE tmp;
	NUMBER *ans;			/* candidate for primality */

	zmodulus = _one_;
	zresidue = _zero_;
	zskip = _one_;
	/*
	 * check on the number of args passed and that args passed are ints
	 */
	switch (count) {
	case 5:
		if (!qisint(vals[4])) {
			math_error( "prevcand 5th arg must both be integer");
			/*NOTREACHED*/
		}
		zmodulus = vals[4]->num;
		/*FALLTHRU*/
	case 4:
		if (!qisint(vals[3])) {
			math_error( "prevcand 4th arg must both be integer");
			/*NOTREACHED*/
		}
		zresidue = vals[3]->num;
		/*FALLTHRU*/
	case 3:
		if (!qisint(vals[2])) {
			math_error(
		    "prevcand skip arg (3rd) must be an integer or omitted");
			/*NOTREACHED*/
		}
		zskip = vals[2]->num;
		/*FALLTHRU*/
	case 2:
		if (!qisint(vals[1])) {
			math_error(
		    "prevcand count arg (2nd) must be an integer or omitted");
			/*NOTREACHED*/
		}
		zcount = &vals[1]->num;
		/*FALLTHRU*/
	case 1:
		if (!qisint(vals[0])) {
			math_error(
		    "prevcand search arg (1st) must be an integer");
			/*NOTREACHED*/
		}
		break;
	default:
		math_error("invalid number of args passed to prevcand");
		/*NOTREACHED*/
	}

	if (zcount == NULL) {
		count = 1;	/* default is 1 ptest */
	} else {
		if (zge24b(*zcount)) {
			math_error("prevcand count arg (2nd) must be < 2^24");
			/*NOTREACHED*/
		}
		count = ztoi(*zcount);
	}

	/*
	 * find the candidate
	 */
	if (zprevcand(vals[0]->num, count, zskip, zresidue, zmodulus, &tmp)) {
		ans = qalloc();
		ans->num = tmp;
		return ans;
	}
	return qlink(&_qzero_);
}


static NUMBER *
f_nextcand(int count, NUMBER **vals)
{
	ZVALUE zmodulus;
	ZVALUE zresidue;
	ZVALUE zskip;
	ZVALUE *zcount = NULL;		/* ptest trial count */
	ZVALUE tmp;
	NUMBER *ans;			/* candidate for primality */

	zmodulus = _one_;
	zresidue = _zero_;
	zskip = _one_;
	/*
	 * check on the number of args passed and that args passed are ints
	 */
	switch (count) {
	case 5:
		if (!qisint(vals[4])) {
			math_error(
		    "nextcand 5th args must be integer");
			/*NOTREACHED*/
		}
		zmodulus = vals[4]->num;
		/*FALLTHRU*/
	case 4:
		if (!qisint(vals[3])) {
			math_error(
		    "nextcand 5th args must be integer");
			/*NOTREACHED*/
		}
		zresidue = vals[3]->num;
		/*FALLTHRU*/
	case 3:
		if (!qisint(vals[2])) {
			math_error(
		    "nextcand skip arg (3rd) must be an integer or omitted");
			/*NOTREACHED*/
		}
		zskip = vals[2]->num;
		/*FALLTHRU*/
	case 2:
		if (!qisint(vals[1])) {
			math_error(
		    "nextcand count arg (2nd) must be an integer or omitted");
			/*NOTREACHED*/
		}
		zcount = &vals[1]->num;
		/*FALLTHRU*/
	case 1:
		if (!qisint(vals[0])) {
			math_error(
		    "nextcand search arg (1st) must be an integer");
			/*NOTREACHED*/
		}
		break;
	default:
		math_error("invalid number of args passed to nextcand");
		/*NOTREACHED*/
	}

	/*
	 * check ranges on integers passed
	 */
	if (zcount == NULL) {
		count = 1;	/* default is 1 ptest */
	} else {
		if (zge24b(*zcount)) {
			math_error("prevcand count arg (2nd) must be < 2^24");
			/*NOTREACHED*/
		}
		count = ztoi(*zcount);
	}

	/*
	 * find the candidate
	 */
	if  (znextcand(vals[0]->num, count, zskip, zresidue, zmodulus, &tmp)) {
		ans = qalloc();
		ans->num = tmp;
		return ans;
	}
	return qlink(&_qzero_);
}


static NUMBER *
f_seed(void)
{
	return pseudo_seed();
}


static NUMBER *
f_rand(int count, NUMBER **vals)
{
	NUMBER *ans;

	/* parse args */
	switch (count) {
	case 0:			/* rand() == rand(2^64) */
		/* generate an a55 random number */
		ans = qalloc();
		zrand(SBITS, &ans->num);
		break;

	case 1:			/* rand(limit) */
		if (!qisint(vals[0])) {
			math_error("rand limit must be an integer");
			/*NOTREACHED*/
		}
		if (zislezero(vals[0]->num)) {
			math_error("rand limit must > 0");
			/*NOTREACHED*/
		}
		ans = qalloc();
		zrandrange(_zero_, vals[0]->num, &ans->num);
		break;

	case 2:			/* rand(low, limit) */
		/* firewall */
		if (!qisint(vals[0]) || !qisint(vals[1])) {
			math_error("rand range must be integers");
			/*NOTREACHED*/
		}
		ans = qalloc();
		zrandrange(vals[0]->num, vals[1]->num, &ans->num);
		break;

	default:
		math_error("invalid number of args passed to rand");
		/*NOTREACHED*/
		return NULL;
	}

	/* return the a55 random number */
	return ans;
}


static NUMBER *
f_randbit(int count, NUMBER **vals)
{
	NUMBER *ans;
	ZVALUE ztmp;
	long cnt;		/* bits needed or skipped */

	/* parse args */
	if (count == 0) {
		zrand(1, &ztmp);
		ans = ziszero(ztmp) ? qlink(&_qzero_) : qlink(&_qone_);
		zfree(ztmp);
		return ans;
	}

	/*
	 * firewall
	 */
	if (!qisint(vals[0])) {
		math_error("rand bit count must be an integer");
		/*NOTREACHED*/
	}
	if (zge31b(vals[0]->num)) {
		math_error("huge rand bit count");
		/*NOTREACHED*/
	}

	/*
	 * generate an a55 random number or skip random bits
	 */
	ans = qalloc();
	cnt = ztolong(vals[0]->num);
	if (zisneg(vals[0]->num)) {
		/* skip bits */
		zrandskip(cnt);
		itoz(cnt, &ans->num);
	} else {
		/* generate bits */
		zrand(cnt, &ans->num);
	}

	/*
	 * return the a55 random number
	 */
	return ans;
}


static VALUE
f_srand(int count, VALUE **vals)
{
	VALUE result;

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

	/* parse args */
	switch (count) {
	case 0:
		/* get the current a55 state */
		result.v_rand = zsrand(NULL, NULL);
		break;

	case 1:
		switch (vals[0]->v_type) {
		case V_NUM:		/* srand(seed) */
			/* seed a55 and return previous state */
			if (!qisint(vals[0]->v_num)) {
				math_error(
				  "srand number seed must be an integer");
				/*NOTREACHED*/
			}
			result.v_rand = zsrand(&vals[0]->v_num->num, NULL);
			break;

		case V_RAND:		/* srand(state) */
			/* set a55 state and return previous state */
			result.v_rand = zsetrand(vals[0]->v_rand);
			break;

		case V_MAT:
			/* load additive 55 table and return previous state */
			result.v_rand = zsrand(NULL, vals[0]->v_mat);
			break;

		default:
			math_error("illegal type of arg passed to srand()");
			/*NOTREACHED*/
			break;
		}
		break;

	default:
		math_error("bad arg count to srand()");
		/*NOTREACHED*/
		break;
	}

	/* return the current state */
	return result;
}


static NUMBER *
f_random(int count, NUMBER **vals)
{
	NUMBER *ans;

	/* parse args */
	switch (count) {
	case 0:			/* random() == random(2^64) */
		/* generate a Blum-Blum-Shub random number */
		ans = qalloc();
		zrandom(SBITS, &ans->num);
		break;

	case 1:			/* random(limit) */
		if (!qisint(vals[0])) {
			math_error("random limit must be an integer");
			/*NOTREACHED*/
		}
		if (zislezero(vals[0]->num)) {
			math_error("random limit must > 0");
			/*NOTREACHED*/
		}
		ans = qalloc();
		zrandomrange(_zero_, vals[0]->num, &ans->num);
		break;

	case 2:			/* random(low, limit) */
		/* firewall */
		if (!qisint(vals[0]) || !qisint(vals[1])) {
			math_error("random range must be integers");
			/*NOTREACHED*/
		}
		ans = qalloc();
		zrandomrange(vals[0]->num, vals[1]->num, &ans->num);
		break;

	default:
		math_error("invalid number of args passed to random");
		/*NOTREACHED*/
		return NULL;
	}

	/* return the Blum-Blum-Shub random number */
	return ans;
}


static NUMBER *
f_randombit(int count, NUMBER **vals)
{
	NUMBER *ans;
	ZVALUE ztmp;
	long cnt;		/* bits needed or skipped */

	/* parse args */
	if (count == 0) {
		zrandom(1, &ztmp);
		ans = ziszero(ztmp) ? qlink(&_qzero_) : qlink(&_qone_);
		zfree(ztmp);
		return ans;
	}

	/*
	 * firewall
	 */
	if (!qisint(vals[0])) {
		math_error("random bit count must be an integer");
		/*NOTREACHED*/
	}
	if (zge31b(vals[0]->num)) {
		math_error("huge random bit count");
		/*NOTREACHED*/
	}

	/*
	 * generate a Blum-Blum-Shub random number or skip random bits
	 */
	ans = qalloc();
	cnt = ztolong(vals[0]->num);
	if (zisneg(vals[0]->num)) {
		/* skip bits */
		zrandomskip(cnt);
		itoz(cnt, &ans->num);
	} else {
		/* generate bits */
		zrandom(cnt, &ans->num);
	}

	/*
	 * return the Blum-Blum-Shub random number
	 */
	return ans;
}


static VALUE
f_srandom(int count, VALUE **vals)
{
	VALUE result;

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

	/* parse args */
	switch (count) {
	case 0:		/* srandom() */
		/* get the current random state */
		result.v_random = zsetrandom(NULL);
		break;

	case 1:		/* srandom(seed) or srandom(state) */
		switch (vals[0]->v_type) {
		case V_NUM:		/* srand(seed) */
			/* seed Blum and return previous state */
			if (!qisint(vals[0]->v_num)) {
				math_error(
				  "srandom number seed must be an integer");
				/*NOTREACHED*/
			}
			result.v_random = zsrandom1(vals[0]->v_num->num, TRUE);
			break;

		case V_RANDOM:		/* srandom(state) */
			/* set a55 state and return previous state */
			result.v_random = zsetrandom(vals[0]->v_random);
			break;

		default:
			math_error("illegal type of arg passed to srandom()");
			/*NOTREACHED*/
			break;
		}
		break;

	case 2:		/* srandom(seed, newn) */
		if (vals[0]->v_type != V_NUM || !qisint(vals[0]->v_num)) {
			math_error("srandom seed must be an integer");
			/*NOTREACHED*/
		}
		if (vals[1]->v_type != V_NUM || !qisint(vals[1]->v_num)) {
			math_error("srandom Blum modulus must be an integer");
			/*NOTREACHED*/
		}
		result.v_random = zsrandom2(vals[0]->v_num->num,
					    vals[1]->v_num->num);
		break;

	case 4:		/* srandom(seed, ip, iq, trials) */
		if (vals[0]->v_type != V_NUM || !qisint(vals[0]->v_num)) {
			math_error("srandom seed must be an integer");
			/*NOTREACHED*/
		}
		if (vals[1]->v_type != V_NUM || !qisint(vals[1]->v_num)) {
			math_error("srandom 2nd arg must be an integer");
			/*NOTREACHED*/
		}
		if (vals[2]->v_type != V_NUM || !qisint(vals[2]->v_num)) {
			math_error("srandom 3rd arg must be an integer");
			/*NOTREACHED*/
		}
		if (vals[3]->v_type != V_NUM || !qisint(vals[3]->v_num)) {
			math_error("srandom 4th arg must be an integer");
			/*NOTREACHED*/
		}
		if (zge24b(vals[3]->v_num->num)) {
			math_error("srandom trials count is excessive");
			/*NOTREACHED*/
		}
		result.v_random = zsrandom4(vals[0]->v_num->num,
					    vals[1]->v_num->num,
					    vals[2]->v_num->num,
					    ztoi(vals[3]->v_num->num));
		break;

	default:
		math_error("bad arg count to srandom()");
		/*NOTREACHED*/
		break;
	}

	/* return the current state */
	return result;
}


static NUMBER *
f_primetest(int count, NUMBER **vals)
{
	/* parse args */
	switch (count) {
	case 1: return itoq((long) qprimetest(vals[0],
			    qlink(&_qone_), qlink(&_qone_)));
	case 2: return itoq((long) qprimetest(vals[0],
			    vals[1], qlink(&_qone_)));
	default: return itoq((long) qprimetest(vals[0], vals[1], vals[2]));
	}
}


static VALUE
f_setbit(int count, VALUE **vals)
{
	BOOL r;
	long index;
	VALUE result;

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

	r = (count == 3) ? testvalue(vals[2]) : 1;

	if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num))
		return error_value(E_SETBIT1);
	if (zge31b(vals[1]->v_num->num))
		return error_value(E_SETBIT2);
	if (vals[0]->v_type != V_STR)
		return error_value(E_SETBIT3);
	index = qtoi(vals[1]->v_num);
	if (stringsetbit(vals[0]->v_str, index, r))
		return error_value(E_SETBIT2);
	return result;
}


static VALUE
f_digit(int count, VALUE **vals)
{
	VALUE res;
	ZVALUE base;

	if (vals[0]->v_type != V_NUM)
		return error_value(E_DGT1);

	if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num))
		return error_value(E_DGT2);

	if (count == 3) {
		if (vals[2]->v_type != V_NUM || qisfrac(vals[2]->v_num))
			return error_value(E_DGT3);
		base = vals[2]->v_num->num;
	} else {
		base = _ten_;
	}
	res.v_type = V_NUM;
	res.v_num = qdigit(vals[0]->v_num, vals[1]->v_num->num, base);
	if (res.v_num == NULL)
		return error_value(E_DGT3);

	return res;
}


static VALUE
f_digits(int count, VALUE **vals)
{
	ZVALUE base;
	VALUE res;

	if (vals[0]->v_type != V_NUM)
		return error_value(E_DGTS1);
	if (count > 1) {
		if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num)
			|| qiszero(vals[1]->v_num) || qisunit(vals[1]->v_num))
			return error_value(E_DGTS2);
		base = vals[1]->v_num->num;
	} else {
		base = _ten_;
	}
	res.v_type = V_NUM;
	res.v_num = itoq(qdigits(vals[0]->v_num, base));
	return res;
}


static VALUE
f_places(int count, VALUE **vals)
{
	long places;
	VALUE res;

	if (vals[0]->v_type != V_NUM)
		return error_value(E_PLCS1);
	if (count > 1) {
		if (vals[1]->v_type != V_NUM || qisfrac(vals[1]->v_num))
			return error_value(E_PLCS2);
		places = qplaces(vals[0]->v_num, vals[1]->v_num->num);