func.c

早期freebsd实现

{
	NUMBER *val2;

	if (qisint(val))
		return qlink(val);
	val2 = qint(val);
	if (qisneg(val))
		return val2;
	val = qinc(val2);
	qfree(val2);
	return val;
}


static NUMBER *
f_floor(val)
	NUMBER *val;
{
	NUMBER *val2;

	if (qisint(val))
		return qlink(val);
	val2 = qint(val);
	if (!qisneg(val))
		return val2;
	val = qdec(val2);
	qfree(val2);
	return val;
}


static NUMBER *
f_highbit(val)
	NUMBER *val;
{
	if (qiszero(val))
		math_error("Highbit of zero");
	if (qisfrac(val))
		math_error("Highbit of non-integer");
	return itoq(zhighbit(val->num));
}


static NUMBER *
f_lowbit(val)
	NUMBER *val;
{
	if (qiszero(val))
		math_error("Lowbit of zero");
	if (qisfrac(val))
		math_error("Lowbit of non-integer");
	return itoq(zlowbit(val->num));
}


static VALUE
f_sqrt(count, vals)
	int count;
	VALUE **vals;
{
	VALUE *vp, err, result;

	if (count > 1)
		vp = vals[1];
	else {
		err.v_num = _epsilon_;
		err.v_type = V_NUM;
		vp = &err;
	}
	sqrtvalue(vals[0], vp, &result);
	return result;
}


static VALUE
f_root(count, vals)
	int count;
	VALUE **vals;
{
	VALUE *vp, err, result;

	if (count > 2)
		vp = vals[3];
	else {
		err.v_num = _epsilon_;
		err.v_type = V_NUM;
		vp = &err;
	}
	rootvalue(vals[0], vals[1], vp, &result);
	return result;
}


static VALUE
f_power(count, vals)
	int count;
	VALUE **vals;
{
	VALUE *vp, err, result;

	if (count > 2)
		vp = vals[2];
	else {
		err.v_num = _epsilon_;
		err.v_type = V_NUM;
		vp = &err;
	}
	powervalue(vals[0], vals[1], vp, &result);
	return result;
}


static VALUE
f_polar(count, vals)
	int count;
	VALUE **vals;
{
	VALUE *vp, err, result;
	COMPLEX *c;

	if (count > 2)
		vp = vals[2];
	else {
		err.v_num = _epsilon_;
		err.v_type = V_NUM;
		vp = &err;
	}
	if ((vals[0]->v_type != V_NUM) || (vals[1]->v_type != V_NUM))
		math_error("Non-real argument for polar");
	if ((vp->v_type != V_NUM) || qisneg(vp->v_num) || qiszero(vp->v_num))
		math_error("Bad epsilon value for polar");
	c = cpolar(vals[0]->v_num, vals[1]->v_num, vp->v_num);
	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);
	}
	return result;
}


static NUMBER *
f_ilog(val1, val2)
	NUMBER *val1, *val2;
{
	return itoq(qilog(val1, val2));
}


static NUMBER *
f_ilog2(val)
	NUMBER *val;
{
	return itoq(qilog2(val));
}


static NUMBER *
f_ilog10(val)
	NUMBER *val;
{
	return itoq(qilog10(val));
}


static NUMBER *
f_faccnt(val1, val2)
	NUMBER *val1, *val2;
{
	return itoq(qdivcount(val1, val2));
}


static VALUE
f_matfill(count, vals)
	int count;
	VALUE **vals;
{
	VALUE *v1, *v2, *v3;
	VALUE result;

	v1 = vals[0];
	v2 = vals[1];
	v3 = (count == 3) ? vals[2] : NULL;
	if (v1->v_type != V_ADDR)
		math_error("Non-variable argument for matfill");
	v1 = v1->v_addr;
	if (v1->v_type != V_MAT)
		math_error("Non-matrix for matfill");
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if (v3 && (v3->v_type == V_ADDR))
		v3 = v3->v_addr;
	matfill(v1->v_mat, v2, v3);
	result.v_type = V_NULL;
	return result;
}


static VALUE
f_mattrans(vp)
	VALUE *vp;
{
	VALUE result;

	if (vp->v_type != V_MAT)
		math_error("Non-matrix argument for mattrans");
	result.v_type = V_MAT;
	result.v_mat = mattrans(vp->v_mat);
	return result;
}


static VALUE
f_det(vp)
	VALUE *vp;
{
	if (vp->v_type != V_MAT)
		math_error("Non-matrix argument for det");
	return matdet(vp->v_mat);
}


static VALUE
f_matdim(vp)
	VALUE *vp;
{
	VALUE result;

	if (vp->v_type != V_MAT)
		math_error("Non-matrix argument for matdim");
	result.v_type = V_NUM;
	result.v_num = itoq((long) vp->v_mat->m_dim);
	return result;
}


static VALUE
f_matmin(v1, v2)
	VALUE *v1, *v2;
{
	VALUE result;
	NUMBER *q;
	long i;

	if ((v1->v_type != V_MAT) || (v2->v_type != V_NUM))
		math_error("Bad argument type for matmin");
	q = v2->v_num;
	i = qtoi(q);
	if (qisfrac(q) || qisneg(q) || (i <= 0) || (i > v1->v_mat->m_dim))
		math_error("Bad dimension value for matmin");
	result.v_type = V_NUM;
	result.v_num = itoq(v1->v_mat->m_min[i - 1]);
	return result;
}


static VALUE
f_matmax(v1, v2)
	VALUE *v1, *v2;
{
	VALUE result;
	NUMBER *q;
	long i;

	if ((v1->v_type != V_MAT) || (v2->v_type != V_NUM))
		math_error("Bad argument type for matmax");
	q = v2->v_num;
	i = qtoi(q);
	if (qisfrac(q) || qisneg(q) || (i <= 0) || (i > v1->v_mat->m_dim))
		math_error("Bad dimension value for matmax");
	result.v_type = V_NUM;
	result.v_num = itoq(v1->v_mat->m_max[i - 1]);
	return result;
}


static VALUE
f_cp(v1, v2)
	VALUE *v1, *v2;
{
	VALUE result;

	if ((v1->v_type != V_MAT) || (v2->v_type != V_MAT))
		math_error("Non-matrix argument for cross product");
	result.v_type = V_MAT;
	result.v_mat = matcross(v1->v_mat, v2->v_mat);
	return result;
}


static VALUE
f_dp(v1, v2)
	VALUE *v1, *v2;
{
	if ((v1->v_type != V_MAT) || (v2->v_type != V_MAT))
		math_error("Non-matrix argument for dot product");
	return matdot(v1->v_mat, v2->v_mat);
}


static VALUE
f_strlen(vp)
	VALUE *vp;
{
	VALUE result;

	if (vp->v_type != V_STR)
		math_error("Non-string argument for strlen");
	result.v_type = V_NUM;
	result.v_num = itoq((long) strlen(vp->v_str));
	return result;
}


static VALUE
f_strcat(count, vals)
	int count;
	VALUE **vals;
{
	register VALUE **vp;
	register char *cp;
	int i;
	long len;
	long lengths[IN];
	VALUE result;

	len = 1;
	vp = vals;
	for (i = 0; i < count; i++) {
		if ((*vp)->v_type != V_STR)
			math_error("Non-string argument for strcat");
		lengths[i] = strlen((*vp)->v_str);
		len += lengths[i];
		vp++;
	}
	cp = (char *)malloc(len);
	if (cp == NULL)
		math_error("No memory for strcat");
	result.v_str = cp;
	result.v_type = V_STR;
	result.v_subtype = V_STRALLOC;
	i = 0;
	for (vp = vals; count-- > 0; vp++) {
		strcpy(cp, (*vp)->v_str);
		cp += lengths[i++];
	}
	return result;
}


static VALUE
f_substr(v1, v2, v3)
	VALUE *v1, *v2, *v3;
{
	NUMBER *q1, *q2;
	long i1, i2, len;
	char *cp;
	VALUE result;

	if (v1->v_type != V_STR)
		math_error("Non-string argument for substr");
	if ((v2->v_type != V_NUM) || (v3->v_type != V_NUM))
		math_error("Non-numeric positions for substr");
	q1 = v2->v_num;
	q2 = v3->v_num;
	if (qisfrac(q1) || qisneg(q1) || qisfrac(q2) || qisneg(q2))
		math_error("Illegal positions for substr");
	i1 = qtoi(q1);
	i2 = qtoi(q2);
	cp = v1->v_str;
	len = strlen(cp);
	result.v_type = V_STR;
	if (i1 > 0)
		i1--;
	if (i1 >= len) {	/* indexing off of end */
		result.v_subtype = V_STRLITERAL;
		result.v_str = "";
		return result;
	}
	cp += i1;
	len -= i1;
	if ((i2 >= len) && (v1->v_subtype == V_STRLITERAL)) {
		result.v_subtype = V_STRLITERAL;
		result.v_str = cp;
		return result;
	}
	if (len > i2)
		len = i2;
	if (len == 1) {
		result.v_subtype = V_STRLITERAL;
		result.v_str = charstr(*cp);
		return result;
	}
	result.v_subtype = V_STRALLOC;
	result.v_str = (char *)malloc(len + 1);
	if (result.v_str == NULL)
		math_error("No memory for substr");
	strncpy(result.v_str, cp, len);
	result.v_str[len] = '\0';
	return result;
}


static VALUE
f_char(vp)
	VALUE *vp;
{
	long num;
	NUMBER *q;
	VALUE result;

	if (vp->v_type != V_NUM)
		math_error("Non-numeric argument for char");
	q = vp->v_num;
	num = qtoi(q);
	if (qisneg(q) || qisfrac(q) || zisbig(q->num) || (num > 255))
		math_error("Illegal number for char");
	result.v_type = V_STR;
	result.v_subtype = V_STRLITERAL;
	result.v_str = charstr((int) num);
	return result;
}


static VALUE
f_ord(vp)
	VALUE *vp;
{
	char *str;
	VALUE result;

	if (vp->v_type != V_STR)
		math_error("Non-string argument for ord");
	str = vp->v_str;
	if (str[0] && str[1])
		math_error("Multi-character string given for ord");
	result.v_type = V_NUM;
	result.v_num = itoq((long) (*str & 0xff));
	return result;
}


static VALUE
f_size(vp)
	VALUE *vp;
{
	long count;
	VALUE result;

	switch (vp->v_type) {
		case V_NULL:	count = 0; break;
		case V_MAT:	count = vp->v_mat->m_size; break;
		case V_LIST:	count = vp->v_list->l_count; break;
		case V_ASSOC:	count = vp->v_assoc->a_count; break;
		case V_OBJ:	count = vp->v_obj->o_actions->count; break;
		default:	count = 1; break;
	}
	result.v_type = V_NUM;
	result.v_num = itoq(count);
	return result;
}


static VALUE
f_search(count, vals)
	int count;
	VALUE **vals;
{
	VALUE *v1, *v2;
	NUMBER *q;
	long start;
	long index = -1;
	VALUE result;

	v1 = *vals++;
	v2 = *vals++;
	start = 0;
	if (count == 3) {
		if ((*vals)->v_type != V_NUM)
			math_error("Non-numeric start index for search");
		q = (*vals)->v_num;
		if (qisfrac(q) || qisneg(q))
			math_error("Bad start index for search");
		start = qtoi(q);
	}
	switch (v1->v_type) {
		case V_MAT:
			index = matsearch(v1->v_mat, v2, start);
			break;
		case V_LIST:
			index = listsearch(v1->v_list, v2, start);
			break;
		case V_ASSOC:
			index = assocsearch(v1->v_assoc, v2, start);
			break;
		default:
			math_error("Bad argument type for search");
	}
	result.v_type = V_NULL;
	if (index >= 0) {
		result.v_type = V_NUM;
		result.v_num = itoq(index);
	}
	return result;
}


static VALUE
f_rsearch(count, vals)
	int count;
	VALUE **vals;
{
	VALUE *v1, *v2;
	NUMBER *q;
	long start;
	long index = -1;
	VALUE result;

	v1 = *vals++;
	v2 = *vals++;
	start = MAXFULL;
	if (count == 3) {
		if ((*vals)->v_type != V_NUM)
			math_error("Non-numeric start index for rsearch");
		q = (*vals)->v_num;
		if (qisfrac(q) || qisneg(q))
			math_error("Bad start index for rsearch");
		start = qtoi(q);
	}
	switch (v1->v_type) {
		case V_MAT:
			index = matrsearch(v1->v_mat, v2, start);
			break;
		case V_LIST:
			index = listrsearch(v1->v_list, v2, start);
			break;
		case V_ASSOC:
			index = assocrsearch(v1->v_assoc, v2, start);