opcodes.c

Calc Software Package for Number Calc

}


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

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	fracvalue(vp, &tmp);
	freevalue(stack);
	*stack = tmp;
}


static void
o_abs(void)
{
	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) ||
		!qispos(v2->v_num)) {
		absvalue(v1, v2, &tmp);
		freevalue(stack--);
		freevalue(stack);
		*stack = tmp;
		return;
	}
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack--;
	if ((stack->v_type == V_NUM) && !qisneg(v1->v_num))
		return;
	q = qqabs(v1->v_num);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}


static void
o_norm(void)
{
	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 = qsquare(vp->v_num);
		if (stack->v_type == V_NUM)
			qfree(stack->v_num);
		stack->v_num = q;
		stack->v_type = V_NUM;
		stack->v_subtype = V_NOSUBTYPE;
		return;
	}
	normvalue(vp, &tmp);
	freevalue(stack);
	*stack = tmp;
}


static void
o_square(void)
{
	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 = qsquare(vp->v_num);
		if (stack->v_type == V_NUM)
			qfree(stack->v_num);
		stack->v_num = q;
		stack->v_type = V_NUM;
		stack->v_subtype = V_NOSUBTYPE;
		return;
	}
	squarevalue(vp, &tmp);
	freevalue(stack);
	*stack = tmp;
}


static void
o_test(void)
{
	VALUE *vp;
	int i;

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


static void
o_links(void)
{
	VALUE *vp;
	long links;
	BOOL haveaddress;

	vp = stack;
	haveaddress = (vp->v_type == V_ADDR);
	if (haveaddress)
		vp = vp->v_addr;
	switch (vp->v_type) {
	case V_NUM: links = vp->v_num->links; break;
	case V_COM: links = vp->v_com->links; break;
	case V_STR: links = vp->v_str->s_links; break;
	default:
		freevalue(stack);
		return;
	}
	if (links <= 0) {
		math_error("Non-positive links!!!");
		/*NOTREACHED*/
	}
	freevalue(stack);
	if (!haveaddress)
		links--;
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
	stack->v_num = itoq(links);
}


static void
o_bit (void)
{
	VALUE *v1, *v2;
	long index;
	int r;

	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 (v2->v_type != V_NUM || qisfrac(v2->v_num)) {
		freevalue(stack--);
		freevalue(stack);
		*stack = error_value(E_BIT1);
		return;
	}
	if (zge31b(v2->v_num->num)) {
		freevalue(stack--);
		freevalue(stack);
		*stack = error_value(E_BIT2);
		return;
	}
	index = qtoi(v2->v_num);
	switch (v1->v_type) {
	case V_NUM:
		r = qisset(v1->v_num, index);
		break;
	case V_STR:
		r = stringbit(v1->v_str, index);
		break;
	default:
		r = 2;
	}
	freevalue(stack--);
	freevalue(stack);
	if (r > 1) {
		*stack = error_value(E_BIT1);
	} else if (r < 0) {
		stack->v_type = V_NULL;
	} else {
		stack->v_type = V_NUM;
		stack->v_num = itoq(r);
	}
	stack->v_subtype = V_NOSUBTYPE;
}

static void
o_highbit (void)
{
	VALUE *vp;
	long index;
	unsigned int u;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	switch (vp->v_type) {
	case V_NUM:
		if (qiszero(vp->v_num)) {
			index = -1;
			break;
		}
		if (qisfrac(vp->v_num)) {
			index = -2;
			break;
		}
		index = zhighbit(vp->v_num->num);
		break;
	case V_STR:
		index = stringhighbit(vp->v_str);
		break;
	case V_OCTET:
		u = *vp->v_octet;
		for (index = -1; u; u >>= 1, ++index);
		break;
	default:
		index = -3;
	}
	freevalue(stack);
	switch (index) {
	case -3:
		*stack = error_value(E_HIGHBIT1);
		return;
	case -2:
		*stack = error_value(E_HIGHBIT2);
		return;
	default:
		stack->v_type = V_NUM;
		stack->v_subtype = V_NOSUBTYPE;
		stack->v_num = itoq(index);
	}
}


static void
o_lowbit (void)
{
	VALUE *vp;
	long index;
	unsigned int u;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	switch (vp->v_type) {
	case V_NUM:
		if (qiszero(vp->v_num)) {
			index = -1;
			break;
		}
		if (qisfrac(vp->v_num)) {
			index = -2;
			break;
		}
		index = zlowbit(vp->v_num->num);
		break;
	case V_STR:
		index = stringlowbit(vp->v_str);
		break;
	case V_OCTET:
		u = *vp->v_octet;
		index = -1;
		if (u) do {
			++index;
			u >>= 1;
		} while (!(u & 1));
		break;
	default:
		index = -3;
	}
	freevalue(stack);
	switch (index) {
	case -3:
		*stack = error_value(E_LOWBIT1);
		return;
	case -2:
		*stack = error_value(E_LOWBIT2);
		return;
	default:
		stack->v_type = V_NUM;
		stack->v_subtype = V_NOSUBTYPE;
		stack->v_num = itoq(index);
	}
}


static void
o_content (void)
{
	VALUE *vp;
	VALUE tmp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	contentvalue(vp, &tmp);
	freevalue(stack);
	*stack = tmp;
}


static void
o_hashop (void)
{
	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;
	hashopvalue(v1, v2, &tmp);
	freevalue(stack--);
	freevalue(stack);
	*stack = tmp;
}


static void
o_backslash (void)
{
	VALUE *vp;
	VALUE tmp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	backslashvalue(vp, &tmp);
	freevalue(stack);
	*stack = tmp;
}


static void
o_setminus (void)
{
	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;
	setminusvalue(v1, v2, &tmp);
	freevalue(stack--);
	freevalue(stack);
	*stack = tmp;
}


static void
o_istype(void)
{
	VALUE *v1, *v2;
	int r;

	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_OBJ) || (v2->v_type != V_OBJ))
		r = (v1->v_type == v2->v_type);
	else
		r = (v1->v_obj->o_actions == v2->v_obj->o_actions);
	freevalue(stack--);
	freevalue(stack);
	stack->v_num = itoq((long) r);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}


static void
o_isint(void)
{
	VALUE *vp;
	NUMBER *q;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = stack->v_addr;
	if (vp->v_type != V_NUM) {
		freevalue(stack);
		stack->v_num = qlink(&_qzero_);
		stack->v_type = V_NUM;
		stack->v_subtype = V_NOSUBTYPE;
		return;
	}
	if (qisint(vp->v_num))
		q = qlink(&_qone_);
	else
		q = qlink(&_qzero_);
	if (stack->v_type == V_NUM)
		qfree(stack->v_num);
	stack->v_num = q;
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}


static void
o_isnum(void)
{
	VALUE *vp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	switch (vp->v_type) {
	case V_NUM:
		if (stack->v_type == V_NUM)
			qfree(stack->v_num);
		break;
	case V_COM:
		if (stack->v_type == V_COM)
			comfree(stack->v_com);
		break;
	default:
		freevalue(stack);
		stack->v_num = qlink(&_qzero_);
		stack->v_type = V_NUM;
		stack->v_subtype = V_NOSUBTYPE;
		return;
	}
	stack->v_num = qlink(&_qone_);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}


static void
o_ismat(void)
{
	VALUE *vp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	if (vp->v_type != V_MAT) {
		freevalue(stack);
		stack->v_num = qlink(&_qzero_);
		stack->v_type = V_NUM;
		stack->v_subtype = V_NOSUBTYPE;
		return;
	}
	freevalue(stack);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
	stack->v_num = qlink(&_qone_);
}


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

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


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

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


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

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


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

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


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

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


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

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


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

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


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

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	r = (vp->v_type == V_HASH);
	if (r != 0)
		r = vp->v_hash->hashtype;
	freevalue(stack);
	stack->v_num = itoq((long) r);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}


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

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


static void
o_isblock(void)
{
	VALUE *vp;
	long r;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	r = 0;
	if (vp->v_type == V_NBLOCK)
		r = 2;
	else if (vp->v_type == V_BLOCK)
		r = 1;
	freevalue(stack);
	stack->v_num = itoq(r);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}


static void
o_isoctet(void)
{
	VALUE *vp;
	long r;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	r = (vp->v_type == V_OCTET);
	freevalue(stack);
	stack->v_num = itoq(r);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}


static void
o_isptr(void)
{
	VALUE *vp;
	long r;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	r = 0;
	switch(vp->v_type) {
	case V_OPTR: r = 1; break;
	case V_VPTR: r = 2; break;
	case V_SPTR: r = 3; break;
	case V_NPTR: r = 4; break;
	}
	freevalue(stack);
	stack->v_num = itoq(r);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}


static void
o_isdefined(void)
{
	VALUE *vp;
	long r;
	long index;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	if (vp->v_type != V_STR) {
		math_error("Non-string argument for isdefined");
		/*NOTREACHED*/
	}
	r = 0;
	index = getbuiltinfunc(vp->v_str->s_str);
	if (index >= 0) {
		r = 1;
	} else {
		index = getuserfunc(vp->v_str->s_str);
		if (index >= 0)
			r = 2;
	}
	freevalue(stack);
	stack->v_num = itoq(r);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}