opcodes.c

早期freebsd实现

	}
	vp = mp->m_table;
	for (i = 0; i < size; i++) {
		vp->v_type = V_NUM;
		vp->v_num = qlink(&_qzero_);
		vp++;
	}
	vp = stack[0].v_addr;
	vp->v_type = V_MAT;
	vp->v_mat = mp;
}


/*ARGSUSED*/
static void
o_eleminit(fp, index)
	FUNC *fp;
	long index;
{
	VALUE *vp;
	static VALUE *oldvp;
	MATRIX *mp;
	OBJECT *op;

	vp = &stack[-1];
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	switch (vp->v_type) {
		case V_MAT:
			mp = vp->v_mat;
			if ((index < 0) || (index >= mp->m_size))
				math_error("Too many initializer values");
			oldvp = &mp->m_table[index];
			break;
		case V_OBJ:
			op = vp->v_obj;
			if ((index < 0) || (index >= op->o_actions->count))
				math_error("Too many initializer values");
			oldvp = &op->o_table[index];
			break;
		default:
			math_error("Attempt to initialize non matrix or object");
	}
	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	freevalue(oldvp);
	copyvalue(vp, oldvp);
	stack--;
}


/*ARGSUSED*/
static void
o_indexaddr(fp, dim, writeflag)
	FUNC *fp;
	long dim;		/* dimension of matrix */
	long writeflag;		/* nonzero if element will be written */
{
	int i;
	BOOL flag;
	VALUE *val;
	VALUE *vp;
	VALUE indices[MAXDIM];	/* index values */

	flag = (writeflag != 0);
	if ((dim <= 0) || (dim > MAXDIM))
		math_error("Too many dimensions for indexing");
	val = &stack[-dim];
	if (val->v_type != V_ADDR)
		math_error("Non-pointer for index operation");
	val = val->v_addr;
	vp = &stack[-dim + 1];
	for (i = 0; i < dim; i++) {
		if (vp->v_type == V_ADDR)
			indices[i] = vp->v_addr[0];
		else
			indices[i] = vp[0];
		vp++;
	}
	switch (val->v_type) {
		case V_MAT:
			vp = matindex(val->v_mat, flag, dim, indices);
			break;
		case V_ASSOC:
			vp = associndex(val->v_assoc, flag, dim, indices);
			break;
		default:
			math_error("Illegal value for indexing");
	}
	while (dim-- > 0)
		freevalue(stack--);
	stack->v_type = V_ADDR;
	stack->v_addr = vp;
}


/*ARGSUSED*/
static void
o_elemaddr(fp, index)
	FUNC *fp;
	long index;
{
	if (stack->v_type != V_ADDR)
		math_error("Non-pointer for element reference");
	if (stack->v_addr->v_type != V_OBJ)
		math_error("Referencing element of non-object");
	index = objoffset(stack->v_addr->v_obj, index);
	if (index < 0)
		math_error("Element does not exist for object");
	stack->v_addr = &stack->v_addr->v_obj->o_table[index];
}


static void
o_elemvalue(fp, index)
	FUNC *fp;
	long index;
{
	if (stack->v_type != V_OBJ) {
		(void) o_elemaddr(fp, index);
		(void) o_getvalue();
		return;
	}
	index = objoffset(stack->v_obj, index);
	if (index < 0)
		math_error("Element does not exist for object");
	copyvalue(&stack->v_obj->o_table[index], stack);
}


/*ARGSUSED*/
static void
o_objcreate(fp, arg)
	FUNC *fp;
	long arg;
{
	OBJECT *op;		/* object being created */
	VALUE *vp;		/* value being defined */

	if (stack->v_type != V_ADDR)
		math_error("Attempting to init object for non-address");
	op = objalloc(arg);
	vp = stack->v_addr;
	vp->v_type = V_OBJ;
	vp->v_obj = op;
}


static void
o_assign()
{
	VALUE *var;		/* variable value */
	VALUE *vp;

	var = &stack[-1];
	if (var->v_type != V_ADDR)
		math_error("Assignment into non-variable");
	var = var->v_addr;
	stack[-1] = stack[0];
	stack--;
	vp = stack;
	if (vp->v_type == V_ADDR) {
		vp = vp->v_addr;
		if (vp == var)
			return;
	}
	freevalue(var);
	copyvalue(vp, var);
}


static void
o_assignpop()
{
	VALUE *var;		/* variable value */
	VALUE *vp;

	var = &stack[-1];
	if (var->v_type != V_ADDR)
		math_error("Assignment into non-variable");
	var = var->v_addr;
	vp = &stack[0];
	if ((vp->v_type == V_ADDR) && (vp->v_addr == var)) {
		stack -= 2;
		return;
	}
	freevalue(var);
	if (vp->v_type == V_ADDR)
		copyvalue(vp->v_addr, var);
	else
		*var = *vp;
	stack -= 2;
}


static void
o_swap()
{
	VALUE *v1, *v2;		/* variables to be swapped */
	VALUE tmp;

	v1 = &stack[-1];
	v2 = &stack[0];
	if ((v1->v_type != V_ADDR) || (v2->v_type != V_ADDR))
		math_error("Swapping non-variables");
	tmp = v1->v_addr[0];
	v1->v_addr[0] = v2->v_addr[0];
	v2->v_addr[0] = tmp;
	stack--;
	stack->v_type = V_NULL;
}


static void
o_add()
{
	VALUE *v1, *v2;
	NUMBER *q;
	VALUE tmp;

	v1 = &stack[-1];
	v2 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM)) {
		addvalue(v1, v2, &tmp);
		freevalue(stack--);
		freevalue(stack);
		*stack = tmp;
		return;
	}
	q = qadd(v1->v_num, v2->v_num);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
}


static void
o_sub()
{
	VALUE *v1, *v2;
	NUMBER *q;
	VALUE tmp;

	v1 = &stack[-1];
	v2 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM)) {
		subvalue(v1, v2, &tmp);
		freevalue(stack--);
		freevalue(stack);
		*stack = tmp;
		return;
	}
	q = qsub(v1->v_num, v2->v_num);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
}


static void
o_mul()
{
	VALUE *v1, *v2;
	NUMBER *q;
	VALUE tmp;

	v1 = &stack[-1];
	v2 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM)) {
		mulvalue(v1, v2, &tmp);
		freevalue(stack--);
		freevalue(stack);
		*stack = tmp;
		return;
	}
	q = qmul(v1->v_num, v2->v_num);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
}


static void
o_power()
{
	VALUE *v1, *v2;
	VALUE tmp;

	v1 = &stack[-1];
	v2 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	powivalue(v1, v2, &tmp);
	freevalue(stack--);
	freevalue(stack);
	*stack = tmp;
}


static void
o_div()
{
	VALUE *v1, *v2;
	NUMBER *q;
	VALUE tmp;

	v1 = &stack[-1];
	v2 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM)) {
		divvalue(v1, v2, &tmp);
		freevalue(stack--);
		freevalue(stack);
		*stack = tmp;
		return;
	}
	q = qdiv(v1->v_num, v2->v_num);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
}


static void
o_quo()
{
	VALUE *v1, *v2;
	NUMBER *q;
	VALUE tmp;

	v1 = &stack[-1];
	v2 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM)) {
		quovalue(v1, v2, &tmp);
		freevalue(stack--);
		freevalue(stack);
		*stack = tmp;
		return;
	}
	q = qquo(v1->v_num, v2->v_num);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
}


static void
o_mod()
{
	VALUE *v1, *v2;
	NUMBER *q;
	VALUE tmp;

	v1 = &stack[-1];
	v2 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM)) {
		modvalue(v1, v2, &tmp);
		freevalue(stack--);
		freevalue(stack);
		*stack = tmp;
		return;
	}
	q = qmod(v1->v_num, v2->v_num);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
}


static void
o_quomod()
{
	VALUE *v1, *v2, *v3, *v4;
	VALUE valquo, valmod;
	BOOL res;

	v1 = &stack[-3];
	v2 = &stack[-2];
	v3 = &stack[-1];
	v4 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v3->v_type != V_ADDR) || (v4->v_type != V_ADDR))
		math_error("Non-variable for quomod");
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM))
		math_error("Non-reals for quomod");
	v3 = v3->v_addr;
	v4 = v4->v_addr;
	valquo.v_type = V_NUM;
	valmod.v_type = V_NUM;
	res = qquomod(v1->v_num, v2->v_num, &valquo.v_num, &valmod.v_num);
	freevalue(stack--);
	freevalue(stack--);
	stack--;
	stack->v_num = (res ? qlink(&_qone_) : qlink(&_qzero_));
	stack->v_type = V_NUM;
	freevalue(v3);
	freevalue(v4);
	*v3 = valquo;
	*v4 = valmod;
}


static void
o_and()
{
	VALUE *v1, *v2;
	NUMBER *q;

	v1 = &stack[-1];
	v2 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM))
		math_error("Non-numerics for and");
	q = qand(v1->v_num, v2->v_num);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
}


static void
o_or()
{
	VALUE *v1, *v2;
	NUMBER *q;

	v1 = &stack[-1];
	v2 = &stack[0];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM))
		math_error("Non-numerics for or");
	q = qor(v1->v_num, v2->v_num);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
}


static void
o_not()
{
	VALUE *vp;
	int r;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	r = testvalue(vp);
	freevalue(stack);
	stack->v_num = (r ? qlink(&_qzero_) : qlink(&_qone_));		
	stack->v_type = V_NUM;
}


static void
o_negate()
{
	VALUE *vp;
	NUMBER *q;
	VALUE tmp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	if (vp->v_type == V_NUM) {
		q = qneg(vp->v_num);
		if (stack->v_type == V_NUM)
			qfree(stack->v_num);
		stack->v_num = q;
		stack->v_type = V_NUM;
		return;
	}
	negvalue(vp, &tmp);
	freevalue(stack);
	*stack = tmp;
}


static void
o_invert()
{
	VALUE *vp;
	NUMBER *q;
	VALUE tmp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	if (vp->v_type == V_NUM) {
		q = qinv(vp->v_num);
		if (stack->v_type == V_NUM)
			qfree(stack->v_num);
		stack->v_num = q;
		stack->v_type = V_NUM;
		return;
	}
	invertvalue(vp, &tmp);
	freevalue(stack);
	*stack = tmp;
}


static void
o_scale()
{
	VALUE *v1, *v2;
	NUMBER *q;
	VALUE tmp;

	v1 = &stack[0];
	v2 = &stack[-1];
	if (v1->v_type == V_ADDR)
		v1 = v1->v_addr;
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v1->v_type != V_NUM) || (v2->v_type != V_NUM)) {
		scalevalue(v2, v1, &tmp);
		freevalue(stack--);
		freevalue(stack);
		*stack = tmp;
		return;
	}
	q = v1->v_num;
	if (qisfrac(q))
		math_error("Non-integral scaling factor");
	if (zisbig(q->num))
		math_error("Very large scaling factor");
	q = qscale(v2->v_num, qtoi(q));
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
}


static void
o_int()
{
	VALUE *vp;
	NUMBER *q;
	VALUE tmp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	if (vp->v_type == V_NUM) {
		if (qisint(vp->v_num) && (stack->v_type == V_NUM))
			return;
		q = qint(vp->v_num);
		if (stack->v_type == V_NUM)
			qfree(stack->v_num);
		stack->v_num = q;
		stack->v_type = V_NUM;
		return;
	}
	intvalue(vp, &tmp);
	freevalue(stack);
	*stack = tmp;
}


static void
o_frac()
{
	VALUE *vp;
	NUMBER *q;
	VALUE tmp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	if (vp->v_type == V_NUM) {
		q = qfrac(vp->v_num);
		if (stack->v_type == V_NUM)
			qfree(stack->v_num);
		stack->v_num = q;
		stack->v_type = V_NUM;
		return;
	}
	fracvalue(vp, &tmp);
	freevalue(stack);
	*stack = tmp;
}


static void
o_abs()
{
	VALUE *v1, *v2;
	NUMBER *q;
	VALUE tmp;

	v1 = &stack[-1];