opcodes.c

Calc Software Package for Number Calc

	relvalue(v1, v2, &tmp);
	freevalue(stack--);
	freevalue(stack);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
	if (tmp.v_type == V_NUM) {
		stack->v_num =	qisneg(tmp.v_num) ? qlink(&_qone_):
				qlink(&_qzero_);
	} else if (tmp.v_type == V_COM) {
		stack->v_num = qlink(&_qzero_);
	} else {
		stack->v_type = V_NULL;
	}
	freevalue(&tmp);
}


static void
o_gt(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;
	relvalue(v1, v2, &tmp);
	freevalue(stack--);
	freevalue(stack);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
	if (tmp.v_type == V_NUM) {
		stack->v_num = qispos(tmp.v_num) ? qlink(&_qone_):
				qlink(&_qzero_);
	} else if (tmp.v_type == V_COM) {
		stack->v_num = qlink(&_qzero_);
	} else {
		stack->v_type = V_NULL;
	}
	freevalue(&tmp);
}


static void
o_preinc(void)
{
	VALUE *vp, tmp;

	if (stack->v_type == V_OCTET) {
		if (stack->v_subtype & (V_NONEWVALUE | V_NOCOPYTO)) {
			*stack = error_value(E_PREINC1);
			return;
		}
		stack->v_octet[0] = stack->v_octet[0] + 1;
		return;
	}
	if (stack->v_type != V_ADDR) {
		freevalue(stack);
		*stack = error_value(E_PREINC2);
		return;
	}
	vp = stack->v_addr;

	if (vp->v_subtype & (V_NONEWVALUE | V_NOASSIGNTO)) {
		*stack = error_value(E_PREINC3);
		return;
	}
	incvalue(vp, &tmp);
	freevalue(vp);
	*vp = tmp;
}


static void
o_predec(void)
{
	VALUE *vp, tmp;

	if (stack->v_type == V_OCTET) {
		if (stack->v_subtype & (V_NONEWVALUE | V_NOCOPYTO)) {
			*stack = error_value(E_PREDEC1);
			return;
		}
		--(*stack->v_octet);
		return;
	}
	if (stack->v_type != V_ADDR) {
		freevalue(stack);
		*stack = error_value(E_PREDEC2);
		return;
	}
	vp = stack->v_addr;
	if (vp->v_subtype & (V_NONEWVALUE | V_NOASSIGNTO)) {
		*stack = error_value(E_PREDEC3);
		return;
	}
	decvalue(vp, &tmp);
	freevalue(vp);
	*vp = tmp;
}


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

	if (stack->v_type == V_OCTET) {
		if (stack->v_subtype & (V_NONEWVALUE | V_NOCOPYTO)) {
			*stack++ = error_value(E_POSTINC1);
			stack->v_type = V_NULL;
			return;
		}
		stack[1] = stack[0];
		stack->v_type = V_NUM;
		stack->v_subtype = V_NOSUBTYPE;
		stack->v_num = itoq((long) stack->v_octet[0]);
		stack++;
		stack->v_octet[0]++;
		return;
	}
	if (stack->v_type != V_ADDR) {
		stack[1] = *stack;
		*stack = error_value(E_POSTINC2);
		stack++;
		return;
	}
	vp = stack->v_addr;
	if (vp->v_subtype & V_NONEWVALUE) {
		stack[1] = *stack;
		*stack = error_value(E_POSTINC3);
		stack++;
		return;
	}
	copyvalue(vp, stack++);
	incvalue(vp, &tmp);
	freevalue(vp);
	*vp = tmp;
	stack->v_type = V_ADDR;
	stack->v_subtype = V_NOSUBTYPE;
	stack->v_addr = vp;
}


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

	if (stack->v_type == V_OCTET) {
		if (stack->v_subtype & (V_NONEWVALUE | V_NOCOPYTO)) {
			*stack++ = error_value(E_POSTDEC1);
			stack->v_type = V_NULL;
			return;
		}
		stack[1] = stack[0];
		stack->v_type = V_NUM;
		stack->v_num = itoq((long) stack->v_octet[0]);
		stack++;
		stack->v_octet[0]--;
		return;
	}
	if (stack->v_type != V_ADDR) {
		stack[1] = *stack;
		*stack = error_value(E_POSTDEC2);
		stack++;
		return;
	}
	vp = stack->v_addr;
	if (vp->v_subtype & (V_NONEWVALUE | V_NOASSIGNTO)) {
		stack[1] = *stack;
		*stack = error_value(E_POSTDEC3);
		stack++;
		return;
	}
	copyvalue(vp, stack++);
	decvalue(vp, &tmp);
	freevalue(vp);
	*vp = tmp;
	stack->v_type = V_ADDR;
	stack->v_subtype = V_NOSUBTYPE;
	stack->v_addr = vp;
}


static void
o_leftshift(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;
	shiftvalue(v1, v2, FALSE, &tmp);
	freevalue(stack--);
	freevalue(stack);
	*stack = tmp;
}


static void
o_rightshift(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;
	shiftvalue(v1, v2, TRUE, &tmp);
	freevalue(stack--);
	freevalue(stack);
	*stack = tmp;
}


/*ARGSUSED*/
static void
o_debug(FUNC UNUSED *fp, long line)
{
	funcline = line;
	if (abortlevel >= ABORT_STATEMENT) {
		math_error("Calculation aborted at statement boundary");
		/*NOTREACHED*/
	}
}


static void
o_printresult(void)
{
	VALUE *vp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	if (vp->v_type != V_NULL) {
		if (conf->tab_ok)
		    math_chr('\t');
		printvalue(vp, PRINT_UNAMBIG);
		math_chr('\n');
		math_flush();
	}
	freevalue(stack--);
}


/*ARGSUSED*/
static void
o_print(FUNC UNUSED *fp, long flags)
{
	VALUE *vp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	printvalue(vp, (int) flags);
	freevalue(stack--);
	if (conf->traceflags & TRACE_OPCODES)
		printf("\n");
	math_flush();
}


static void
o_printeol(void)
{
	math_chr('\n');
	math_flush();
}


static void
o_printspace(void)
{
	math_chr(' ');
	if (conf->traceflags & TRACE_OPCODES)
		printf("\n");
}


/*ARGSUSED*/
static void
o_printstring(FUNC UNUSED *fp, long index)
{
	STRING *s;
	char *cp;

	s = findstring(index);
	cp = s->s_str;
	math_str(cp);
	if (conf->traceflags & TRACE_OPCODES)
		printf("\n");
	math_flush();
}


static void
o_zero(void)
{
	stack++;
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
	stack->v_num = qlink(&_qzero_);
}


static void
o_one(void)
{
	stack++;
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
	stack->v_num = qlink(&_qone_);
}


static void
o_save(FUNC *fp)
{
	VALUE *vp;

	if (saveval || fp->f_name[1] == '*') {
		vp = stack;
		if (vp->v_type == V_ADDR)
			vp = vp->v_addr;
		freevalue(&fp->f_savedvalue);
		copyvalue(vp, &fp->f_savedvalue);
	}
}


static void
o_oldvalue(void)
{
	++stack;
	stack->v_type = V_ADDR;
	stack->v_addr = &oldvalue;
}


void
o_setsaveval(void)
{
	VALUE *vp;

	vp = stack;
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	saveval = testvalue(vp);
	freevalue(stack);
}


static void
o_quit(FUNC *fp, long index)
{
	STRING *s;
	char *cp;

	cp = NULL;
	if (index >= 0) {
		s = findstring(index);
		cp = s->s_str;
	}
	if (inputisterminal() && !strcmp(fp->f_name, "*")) {
		if (cp)
			printf("%s\n", cp);
		hist_term();
		while (stack > stackarray) {
			freevalue(stack--);
		}
		freevalue(stackarray);
		run_state = RUN_EXIT;
		longjmp(jmpbuf, 1);
	}
	if (cp)
		printf("%s\n", cp);
	else if (conf->verbose_quit)
		printf("quit or abort executed\n");
	if (!inputisterminal() && !strcmp(fp->f_name, "*"))
		closeinput();
	go = FALSE;
}


static void
o_abort(FUNC *fp, long index)
{
	abort_now = TRUE;
	o_quit(fp, index);
}


static void
o_getepsilon(void)
{
	stack++;
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
	stack->v_num = qlink(conf->epsilon);
}


static void
o_setepsilon(void)
{
	VALUE *vp;
	NUMBER *newep;

	vp = &stack[0];
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	if (vp->v_type != V_NUM) {
		math_error("Non-numeric for epsilon");
		/*NOTREACHED*/
	}
	newep = vp->v_num;
	stack->v_num = qlink(conf->epsilon);
	setepsilon(newep);
	if (stack->v_type == V_NUM)
		qfree(newep);
	stack->v_type = V_NUM;
	stack->v_subtype = V_NOSUBTYPE;
}


static void
o_setconfig(void)
{
	int type;
	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;
	if (v1->v_type != V_STR) {
		math_error("Non-string for config");
		/*NOTREACHED*/
	}
	type = configtype(v1->v_str->s_str);
	if (type < 0) {
		math_error("Unknown config name \"%s\"",
				v1->v_str->s_str);
		/*NOTREACHED*/
	}
	config_value(conf, type, &tmp);
	setconfig(type, v2);
	freevalue(stack--);
	freevalue(stack);
	*stack = tmp;
}


static void
o_getconfig(void)
{
	int type;
	VALUE *vp;

	vp = &stack[0];
	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;
	if (vp->v_type != V_STR) {
		math_error("Non-string for config");
		/*NOTREACHED*/
	}
	type = configtype(vp->v_str->s_str);
	if (type < 0) {
		math_error("Unknown config name \"%s\"",
			vp->v_str->s_str);
		/*NOTREACHED*/
	}
	freevalue(stack);
	config_value(conf, type, stack);
}


/*
 * Set the 'old' value to the last value saved during the calculation.
 */
void
updateoldvalue(FUNC *fp)
{
	if (fp->f_savedvalue.v_type == V_NULL)
		return;
	freevalue(&oldvalue);
	oldvalue = fp->f_savedvalue;
	fp->f_savedvalue.v_type = V_NULL;
	fp->f_savedvalue.v_subtype = V_NOSUBTYPE;
}


/*
 * error_value - return error as a value and store type in calc_errno
 */
VALUE
error_value(int e)
{
	VALUE res;

	if (-e > 0)
		e = 0;
	calc_errno = e;
	if (e > 0)
		errcount++;
	if (errmax >= 0 && errcount > errmax) {
		math_error("Error %d caused errcount to exceed errmax", e);
		/*NOTREACHED*/
	}
	res.v_type = (short) -e;
	res.v_subtype = V_NOSUBTYPE;
	return res;
}

/*
 * set_errno - return and set calc_errno
 */
int
set_errno(int e)
{
	int res;

	res = calc_errno;
	if (e >= 0)
		calc_errno = e;
	return res;
}


/*
 * set_errcount - return and set errcount
 */
int
set_errcount(int e)
{
	int res;

	res = errcount;
	if (e >= 0)
		errcount = e;
	return res;
}


/*
 * Fill a newly created matrix at v1 with copies of value at v2.
 */
static void
o_initfill(void)
{
	VALUE *v1, *v2;
	int s;
	VALUE *vp;

	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_MAT) {
		math_error("Non-matrix argument for o_initfill");
		/*NOTREACHED*/
	}
	s = v1->v_mat->m_size;
	vp = v1->v_mat->m_table;
	while (s-- > 0)
		copyvalue(v2, vp++);
	freevalue(stack--);
}


/*ARGSUSED*/
static void
o_show(FUNC *fp, long arg)
{
	unsigned int size;

	switch((int) arg) {
	case 1: showbuiltins(); return;
	case 2: showglobals(); return;
	case 3: showfunctions(); return;
	case 4: showobjfuncs(); return;
	case 5: config_print(conf); putchar('\n'); return;
	case 6: showobjtypes(); return;
	case 7: showfiles(); return;
	case 8: showsizes(); return;
	case 9: showerrors(); return;
	case 10: showcustom(); return;
	case 11: shownblocks(); return;
	case 12: showconstants(); return;
	case 13: showallglobals(); return;
	case 14: showstatics(); return;
	case 15: shownumbers(); return;
	case 16: showredcdata(); return;
	case 17: showstrings(); return;
	case 18: showliterals(); return;
	}
	fp = findfunc(arg - 19);
	if (fp == NULL) {
		printf("Function not defined\n");
		return;
	}
	dumpnames = FALSE;
	for (size = 0; size < fp->f_opcodecount; ) {
		printf("%ld: ", (long)size);
		size += dumpop(&fp->f_opcodes[size]);
	}
}


static void
showsizes(void)
{
	printf("\tchar\t\t%4ld\n", (long)sizeof(char));
	printf("\tshort\t\t%4ld\n", (long)sizeof(short));
	printf("\tint\t\t%4ld\n", (long)sizeof(int));
	printf("\tlong\t\t%4ld\n", (long)sizeof(long));
	printf("\tpointer\t\t%4ld\n", (long)sizeof(void *));
	printf("\tFILEPOS\t\t%4ld\n", (long)sizeof(FILEPOS));
	printf("\toff_t\t\t%4ld\n", (long)sizeof(off_t));
	printf("\tHALF\t\t%4ld\n", (long)sizeof(HALF));
	printf("\tFULL\t\t%4ld\n", (long)sizeof(FULL));
	printf("\tVALUE\t\t%4ld\n", (long)sizeof(VALUE));
	printf("\tNUMBER\t\t%4ld\n", (long)sizeof(NUMBER));
	printf("\tZVALUE\t\t%4ld\n", (long)sizeof(ZVALUE));
	printf("\tCOMPLEX\t\t%4ld\n", (long)sizeof(COMPLEX));
	printf("\tSTRING\t\t%4ld\n", (long)sizeof(STRING));
	printf("\tMATRIX\t\t%4ld\n", (long)sizeof(MATRIX));
	printf("\tLIST\t\t%4ld\n", (long)sizeof(LIST));
	printf("\tLISTELEM\t%4ld\n", (long)sizeof(LISTELEM));
	printf("\tOBJECT\t\t%4ld\n", (long)sizeof(OBJECT));
	printf("\tOBJECTACTIONS\t%4ld\n", (long)sizeof(OBJECTACTIONS));
	printf("\tASSOC\t\t%4ld\n", (long)sizeof(ASSOC));
	printf("\tASSOCELEM\t%4ld\n", (long)sizeof(ASSOCELEM));
	printf("\tBLOCK\t\t%4ld\n", (long)sizeof(BLOCK));
	printf("\tNBLOCK\t\t%4ld\n", (long)sizeof(NBLOCK));
	printf("\tCONFIG\t\t%4ld\n", (long)sizeof(CONFIG));
	printf("\tFILEIO\t\t%4ld\n", (long)sizeof(FILEIO));
	printf("\tRAND\t\t%4ld\n", (long)sizeof(RAND));
	printf("\tRANDOM\t\t%4ld\n", (long)sizeof(RANDOM));
}


/*
 * Information about each opcode.
 */
static struct opcode opcodes[MAX_OPCODE+1] = {
	{o_nop,		OPNUL,	"NOP"},		/* no operation */
	{o_localaddr,	OPLOC,	"LOCALADDR"},	/* address of local variable */
	{o_globaladdr,	OPGLB,	"GLOBALADDR"},	/* address of global variable */
	{o_paramaddr,	OPPAR,	"PARAMADDR"},	/* address of parameter variable */
	{o_localvalue,	OPLOC,	"LOCALVALUE"},	/* value of local variable */
	{o_globalvalue, OPGLB,	"GLOBALVALUE"}, /* value of global variable */
	{o_paramvalue,	OPPAR,	"PARAMVALUE"},	/* value of parameter variable */
	{o_number,	OPONE,	"NUMBER"},	/* constant real numeric value */
	{o_indexaddr,	OPTWO,	"INDEXADDR"},	/* array index address */
	{o_printresult, OPNUL,	"PRINTRESULT"}, /* print result of top-level expression */
	{o_assign,	OPNUL,	"ASSIGN"},	/* assign value to variable */
	{o_add,		OPNUL,	"ADD"},		/* add top two values */
	{o_sub,		OPNUL,	"SUB"},		/* subtract top two values */
	{o_mul,		OPNUL,	"MUL"},		/* multiply top two values */
	{o_div,		OPNUL,	"DIV"},		/* divide top two values */
	{o_mod,		OPNUL,	"MOD"},		/* take mod of top two values */
	{o_save,	OPNUL,	"SAVE"},	/* save value for later use */
	{o_negate,	OPNUL,	"NEGATE"},	/* negate top value */
	{o_invert,	OPNUL,	"INVERT"},	/* invert top value */
	{o_int,		OPNUL,	"INT"},		/* take integer part */
	{o_frac,	OPNUL,	"FRAC"},	/* take fraction part */
	{o_numerator,	OPNUL,	"NUMERATOR"},	/* take numerator */
	{o_denominator, OPNUL,	"DENOMINATOR"}, /* take denominator */
	{o_duplicate,	OPNUL,	"DUPLICATE"},	/* duplicate top value */
	{o_pop,		OPNUL,	"POP"},		/* pop top value */
	{o_return,	OPRET,	"RETURN"},	/* return value of function */
	{o_jumpz,	OPJMP,	"JUMPZ"},	/* jump if value zero */
	{o_jumpnz,	OPJMP,	"JUMPNZ"},	/* jump if value nonzero */
	{o_jump,	OPJMP,	"JUMP"},	/* jump unconditionally */
	{o_usercall,	OPTWO,	"USERCALL"},	/* call a user function */
	{o_getvalue,	OPNUL,	"GETVALUE"},	/* convert address to value */
	{o_eq,		OPNUL,	"EQ"},		/* test elements for equality */
	{o_ne,		OPNUL,	"NE"},		/* test elements for inequality */
	{o_le,		OPNUL,	"LE"},		/* test elements for <= */
	{o_ge,		OPNUL,	"GE"},		/* test elements for >= */
	{o_lt,		OPNUL,	"LT"},		/* test elements for < */
	{o_gt,		OPNUL,	"GT"},		/* test elements for > */
	{o_preinc,	OPNUL,	"PREINC"},	/* add one to variable (++x) */
	{o_predec,	OPNUL,	"PREDEC"},	/* subtract one from variable (--x) */
	{o_postinc,	OPNUL,	"POSTINC"},	/* add one to variable (x++) */
	{o_postdec,	OPNUL,	"POSTDEC"},	/* subtract one from variable (x--) */
	{o_debug,	OPONE,	"DEBUG"},	/* debugging point */
	{o_print,	OPONE,	"PRINT"},	/* print value */
	{o_assignpop,	OPNUL,	"ASSIGNPOP"},	/* assign to variable and pop it */
	{o_zero,	OPNUL,	"ZERO"},	/* put zero on the stack */
	{o_one,		OPNUL,	"ONE"},		/* put one on the stack */
	{o_printeol,	OPNUL,	"PRINTEOL"},	/* print end of line */
	{o_printspace,	OPNUL,	"PRINTSPACE"},	/* print a space */
	{o_printstring, OPONE,	"PRINTSTR"},