value.c

Calc Software Package for Number Calc

/*
 * value - generic value manipulation routines
 *
 * Copyright (C) 1999-2006  David I. Bell
 *
 * Calc is open software; you can redistribute it and/or modify it under
 * the terms of the version 2.1 of the GNU Lesser General Public License
 * as published by the Free Software Foundation.
 *
 * Calc is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
 * Public License for more details.
 *
 * A copy of version 2.1 of the GNU Lesser General Public License is
 * distributed with calc under the filename COPYING-LGPL.  You should have
 * received a copy with calc; if not, write to Free Software Foundation, Inc.
 * 59 Temple Place, Suite 330, Boston, MA  02111-1307, USA.
 *
 * @(#) $Revision: 29.10 $
 * @(#) $Id: value.c,v 29.10 2006/08/20 15:01:30 chongo Exp $
 * @(#) $Source: /usr/local/src/cmd/calc/RCS/value.c,v $
 *
 * Under source code control:	1990/02/15 01:48:25
 * File existed as early as:	before 1990
 *
 * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
 */


#include <stdio.h>
#include <sys/types.h>
#include "value.h"
#include "opcodes.h"
#include "func.h"
#include "symbol.h"
#include "string.h"
#include "zrand.h"
#include "zrandom.h"
#include "cmath.h"
#include "nametype.h"
#include "file.h"
#include "config.h"

#define LINELEN 80		/* length of a typical tty line */

/*
 * Free a value and set its type to undefined.
 *
 * given:
 *	vp		value to be freed
 */
void
freevalue(VALUE *vp)
{
	int type;		/* type of value being freed */

	type = vp->v_type;
	vp->v_type = V_NULL;
	vp->v_subtype = V_NOSUBTYPE;
	if (type <= 0)
		return;
	switch (type) {
	case V_ADDR:
	case V_OCTET:
	case V_NBLOCK:
	case V_FILE:
	case V_VPTR:
	case V_OPTR:
	case V_SPTR:
	case V_NPTR:
		/* nothing to free */
		break;
	case V_STR:
		sfree(vp->v_str);
		break;
	case V_NUM:
		qfree(vp->v_num);
		break;
	case V_COM:
		comfree(vp->v_com);
		break;
	case V_MAT:
		matfree(vp->v_mat);
		break;
	case V_LIST:
		listfree(vp->v_list);
		break;
	case V_ASSOC:
		assocfree(vp->v_assoc);
		break;
	case V_OBJ:
		objfree(vp->v_obj);
		break;
	case V_RAND:
		randfree(vp->v_rand);
		break;
	case V_RANDOM:
		randomfree(vp->v_random);
		break;
	case V_CONFIG:
		config_free(vp->v_config);
		break;
	case V_HASH:
		hash_free(vp->v_hash);
		break;
	case V_BLOCK:
		blk_free(vp->v_block);
		break;
	default:
		math_error("Freeing unknown value type");
		/*NOTREACHED*/
	}
}


/*
 * Set protection status for a value and all of its components
 */
void
protecttodepth(VALUE *vp, int sts, int depth)
{
	VALUE *vq;
	int i;
	LISTELEM *ep;
	ASSOC *ap;

	if (vp->v_type == V_NBLOCK) {
		if (sts > 0)
			vp->v_nblock->subtype |= sts;
		else if (sts < 0)
			vp->v_nblock->subtype &= ~(-sts);
		else vp->v_nblock->subtype = 0;
		return;
	}
	if (sts > 0)
		vp->v_subtype |= sts;
	else if (sts < 0)
		vp->v_subtype &= ~(-sts);
	else
		vp->v_subtype = 0;


	if (depth > 0) {
	    switch(vp->v_type) {
	    case V_MAT:
		    vq = vp->v_mat->m_table;
		    i = vp->v_mat->m_size;
		    while (i-- > 0)
			    protecttodepth(vq++, sts, depth - 1);
		    break;
	    case V_LIST:
		    for (ep = vp->v_list->l_first; ep; ep = ep->e_next)
			    protecttodepth(&ep->e_value, sts, depth - 1);
		    break;
	    case V_OBJ:
		    vq = vp->v_obj->o_table;
		    i = vp->v_obj->o_actions->oa_count;
		    while (i-- > 0)
			    protecttodepth(vq++, sts, depth - 1);
		    break;
	    case V_ASSOC:
		    ap = vp->v_assoc;
		    for (i = 0; i < ap->a_count; i++)
			    protecttodepth(assocfindex(ap, i), sts, depth - 1);
	    }
	}
}


/*
 * Copy a value from one location to another.
 * This overwrites the specified new value without checking it.
 *
 * given:
 *	oldvp		value to be copied from
 *	newvp		value to be copied into
 */
void
copyvalue(VALUE *oldvp, VALUE *newvp)
{
	newvp->v_type = oldvp->v_type;
	if (oldvp->v_type >= 0) {
		switch (oldvp->v_type) {
		case V_NULL:
		case V_ADDR:
		case V_VPTR:
		case V_OPTR:
		case V_SPTR:
		case V_NPTR:
			*newvp = *oldvp;
			break;
		case V_FILE:
			newvp->v_file = oldvp->v_file;
			break;
		case V_NUM:
			newvp->v_num = qlink(oldvp->v_num);
			break;
		case V_COM:
			newvp->v_com = clink(oldvp->v_com);
			break;
		case V_STR:
			newvp->v_str = slink(oldvp->v_str);
			break;
		case V_MAT:
			newvp->v_mat = matcopy(oldvp->v_mat);
			break;
		case V_LIST:
			newvp->v_list = listcopy(oldvp->v_list);
			break;
		case V_ASSOC:
			newvp->v_assoc = assoccopy(oldvp->v_assoc);
			break;
		case V_OBJ:
			newvp->v_obj = objcopy(oldvp->v_obj);
			break;
		case V_RAND:
			newvp->v_rand = randcopy(oldvp->v_rand);
			break;
		case V_RANDOM:
			newvp->v_random = randomcopy(oldvp->v_random);
			break;
		case V_CONFIG:
			newvp->v_config = config_copy(oldvp->v_config);
			break;
		case V_HASH:
			newvp->v_hash = hash_copy(oldvp->v_hash);
			break;
		case V_BLOCK:
			newvp->v_block = blk_copy(oldvp->v_block);
			break;
		case V_OCTET:
			newvp->v_type = V_NUM;
			newvp->v_num = itoq((long) *oldvp->v_octet);
			break;
		case V_NBLOCK:
			newvp->v_nblock = oldvp->v_nblock;
			break;
		default:
			math_error("Copying unknown value type");
			/*NOTREACHED*/
		}
	}
	newvp->v_subtype = oldvp->v_subtype;
}


/*
 * copy the low order 8 bits of a value to an octet
 */
void
copy2octet(VALUE *vp, OCTET *op)
{
	USB8 oval;	/* low order 8 bits to store into OCTET */
	NUMBER *q;
	HALF h;

	if (vp->v_type == V_ADDR)
		vp = vp->v_addr;

	oval = 0;

	/*
	 * we can (at the moment) only store certain types
	 * values into an OCTET, so get the low order 8 bits
	 * of these particular value types
	 */
	h = 0;
	switch(vp->v_type) {
	case V_NULL:
		/* nothing to store ... so do nothing */
		return;
	case V_INT:
		oval = (USB8)(vp->v_int & 0xff);
		break;
	case V_NUM:
		if (qisint(vp->v_num)) {
			/* use low order 8 bits of integer value */
			h = vp->v_num->num.v[0];
		} else {
			/* use low order 8 bits of int(value) */
			q = qint(vp->v_num);
			h = q->num.v[0];
			qfree(q);
		}
		if (qisneg(vp->v_num))
			h = -h;
		oval = (USB8) h;
		break;
	case V_COM:
		if (cisint(vp->v_com)) {
			/* use low order 8 bits of integer value */
			h = vp->v_com->real->num.v[0];
		} else {
			/* use low order 8 bits of int(value) */
			q = qint(vp->v_com->real);
			h = q->num.v[0];
			qfree(q);
		}
		if (qisneg(vp->v_com->real))
			h = -h;
		oval = (USB8) h;
		break;
	case V_STR:
		oval = (USB8) vp->v_str->s_str[0];
		break;
	case V_BLOCK:
		oval = (USB8) vp->v_block->data[0];
		break;
	case V_OCTET:
		oval = *vp->v_octet;
		break;
	case V_NBLOCK:
		if (vp->v_nblock->blk->data == NULL)
			return;
		oval = (USB8) vp->v_nblock->blk->data[0];
		break;
	default:
		math_error("invalid assignment into an OCTET");
		break;
	}
	*op = oval;
}


/*
 * Negate an arbitrary value.
 * Result is placed in the indicated location.
 */
void
negvalue(VALUE *vp, VALUE *vres)
{
	vres->v_type = vp->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (vp->v_type) {
	case V_NUM:
		vres->v_num = qneg(vp->v_num);
		return;
	case V_COM:
		vres->v_com = c_neg(vp->v_com);
		return;
	case V_MAT:
		vres->v_mat = matneg(vp->v_mat);
		return;
	case V_STR:
		vres->v_str = stringneg(vp->v_str);
		if (vres->v_str == NULL)
			*vres = error_value(E_STRNEG);
		return;
	case V_OCTET:
		vres->v_type = V_NUM;
		vres->v_subtype = V_NOSUBTYPE;
		vres->v_num = itoq(- (long) *vp->v_octet);
		return;

	case V_OBJ:
		*vres = objcall(OBJ_NEG, vp, NULL_VALUE, NULL_VALUE);
		return;
	default:
		if (vp->v_type <= 0)
			return;
		*vres = error_value(E_NEG);
		return;
	}
}


/*
 * Add two arbitrary values together.
 * Result is placed in the indicated location.
 */
void
addvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
	COMPLEX *c;
	VALUE tmp;
	NUMBER *q;
	long i;

	vres->v_subtype = V_NOSUBTYPE;
	if (v1->v_type == V_LIST) {
		tmp.v_type = V_NULL;
		addlistitems(v1->v_list, &tmp);
		addvalue(&tmp, v2, vres);
		return;
	}
	if (v2->v_type == V_LIST) {
		copyvalue(v1, vres);
		addlistitems(v2->v_list, vres);
		return;
	}
	if (v1->v_type == V_NULL) {
		copyvalue(v2, vres);
		return;
	}
	if (v2->v_type == V_NULL) {
		copyvalue(v1, vres);
		return;
	}
	vres->v_type = v1->v_type;
	switch (TWOVAL(v1->v_type, v2->v_type)) {
	case TWOVAL(V_NUM, V_NUM):
		vres->v_num = qqadd(v1->v_num, v2->v_num);
		return;
	case TWOVAL(V_COM, V_NUM):
		vres->v_com = c_addq(v1->v_com, v2->v_num);
		return;
	case TWOVAL(V_NUM, V_COM):
		vres->v_com = c_addq(v2->v_com, v1->v_num);
		vres->v_type = V_COM;
		return;
	case TWOVAL(V_COM, V_COM):
		vres->v_com = c_add(v1->v_com, v2->v_com);
		c = vres->v_com;
		if (!cisreal(c))
			return;
		vres->v_num = qlink(c->real);
		vres->v_type = V_NUM;
		comfree(c);
		return;
	case TWOVAL(V_MAT, V_MAT):
		vres->v_mat = matadd(v1->v_mat, v2->v_mat);
		return;
	case TWOVAL(V_STR, V_STR):
		vres->v_str = stringadd(v1->v_str, v2->v_str);
		if (vres->v_str == NULL)
			*vres = error_value(E_STRADD);
		return;
	case TWOVAL(V_VPTR, V_NUM):
		q = v2->v_num;
		if (qisfrac(q)) {
			math_error("Adding non-integer to address");
			/*NOTREACHED*/
		}
		i = qtoi(q);
		vres->v_addr = v1->v_addr + i;
		vres->v_type = V_VPTR;
		return;
	case TWOVAL(V_OPTR, V_NUM):
		q = v2->v_num;
		if (qisfrac(q)) {
			math_error("Adding non-integer to address");
			/*NOTREACHED*/
		}
		i = qtoi(q);
		vres->v_octet = v1->v_octet + i;
		vres->v_type = V_OPTR;
		return;
	default:
		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
			if (v1->v_type < 0)
				return;
			if (v2->v_type > 0)
				*vres = error_value(E_ADD);
			else
				vres->v_type = v2->v_type;
			return;
		}
		*vres = objcall(OBJ_ADD, v1, v2, NULL_VALUE);
		return;
	}
}


/*
 * Subtract one arbitrary value from another one.
 * Result is placed in the indicated location.
 */
void
subvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
	COMPLEX *c;
	NUMBER *q;
	int i;

	vres->v_type = v1->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (TWOVAL(v1->v_type, v2->v_type)) {
	case TWOVAL(V_NUM, V_NUM):
		vres->v_num = qsub(v1->v_num, v2->v_num);
		return;
	case TWOVAL(V_COM, V_NUM):
		vres->v_com = c_subq(v1->v_com, v2->v_num);
		return;
	case TWOVAL(V_NUM, V_COM):
		c = c_subq(v2->v_com, v1->v_num);
		vres->v_type = V_COM;
		vres->v_com = c_neg(c);
		comfree(c);
		return;
	case TWOVAL(V_COM, V_COM):
		vres->v_com = c_sub(v1->v_com, v2->v_com);
		c = vres->v_com;
		if (!cisreal(c))
			return;
		vres->v_num = qlink(c->real);
		vres->v_type = V_NUM;
		comfree(c);
		return;
	case TWOVAL(V_MAT, V_MAT):
		vres->v_mat = matsub(v1->v_mat, v2->v_mat);
		return;
	case TWOVAL(V_STR, V_STR):
		vres->v_str = stringsub(v1->v_str, v2->v_str);
		if (vres->v_str == NULL)
			*vres = error_value(E_STRSUB);
		return;
	case TWOVAL(V_VPTR, V_NUM):
		q = v2->v_num;
		if (qisfrac(q)) {
			math_error("Subtracting non-integer from address");
			/*NOTREACHED*/
		}
		i = qtoi(q);
		vres->v_addr = v1->v_addr - i;
		vres->v_type = V_VPTR;
		return;
	case TWOVAL(V_OPTR, V_NUM):
		q = v2->v_num;
		if (qisfrac(q)) {
			math_error("Adding non-integer to address");
			/*NOTREACHED*/
		}
		i = qtoi(q);
		vres->v_octet = v1->v_octet - i;
		vres->v_type = V_OPTR;
		return;
	case TWOVAL(V_VPTR, V_VPTR):
		vres->v_type = V_NUM;
		vres->v_num = itoq(v1->v_addr - v2->v_addr);
		return;
	case TWOVAL(V_OPTR, V_OPTR):
		vres->v_type = V_NUM;
		vres->v_num = itoq(v1->v_octet - v2->v_octet);
		return;
	default:
		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
			if (v1->v_type <= 0)
				return;
			if (v2->v_type <= 0) {
				vres->v_type = v2->v_type;
				return;
			}
			*vres = error_value(E_SUB);
			return;
		}
		*vres = objcall(OBJ_SUB, v1, v2, NULL_VALUE);
		return;
	}
}


/*
 * Multiply two arbitrary values together.
 * Result is placed in the indicated location.
 */
void
mulvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
	COMPLEX *c;

	vres->v_type = v1->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (TWOVAL(v1->v_type, v2->v_type)) {
	case TWOVAL(V_NUM, V_NUM):
		vres->v_num = qmul(v1->v_num, v2->v_num);
		return;
	case TWOVAL(V_COM, V_NUM):
		vres->v_com = c_mulq(v1->v_com, v2->v_num);
		break;
	case TWOVAL(V_NUM, V_COM):
		vres->v_com = c_mulq(v2->v_com, v1->v_num);
		vres->v_type = V_COM;
		break;
	case TWOVAL(V_COM, V_COM):
		vres->v_com = c_mul(v1->v_com, v2->v_com);
		break;
	case TWOVAL(V_MAT, V_MAT):
		vres->v_mat = matmul(v1->v_mat, v2->v_mat);
		return;
	case TWOVAL(V_MAT, V_NUM):
	case TWOVAL(V_MAT, V_COM):
		vres->v_mat = matmulval(v1->v_mat, v2);
		return;
	case TWOVAL(V_NUM, V_MAT):
	case TWOVAL(V_COM, V_MAT):
		vres->v_mat = matmulval(v2->v_mat, v1);
		vres->v_type = V_MAT;
		return;
	case TWOVAL(V_NUM, V_STR):
		vres->v_type = V_STR;
		vres->v_str = stringmul(v1->v_num, v2->v_str);
		if (vres->v_str == NULL)
			*vres = error_value(E_STRMUL);
		return;
	case TWOVAL(V_STR, V_NUM):
		vres->v_str= stringmul(v2->v_num, v1->v_str);
		if (vres->v_str == NULL)
			*vres = error_value(E_STRMUL);
		return;
	default:
		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
			if (v1->v_type <= 0)
				return;
			if (v2->v_type <= 0) {
				vres->v_type = v2->v_type;
				return;
			}
			*vres = error_value(E_MUL);
			return;
		}
		*vres = objcall(OBJ_MUL, v1, v2, NULL_VALUE);
		return;
	}
	c = vres->v_com;
	if (cisreal(c)) {
		vres->v_num = qlink(c->real);
		vres->v_type = V_NUM;
		comfree(c);
	}
}


/*
 * Square an arbitrary value.
 * Result is placed in the indicated location.
 */
void
squarevalue(VALUE *vp, VALUE *vres)
{
	COMPLEX *c;

	vres->v_type = vp->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (vp->v_type) {
	case V_NUM:
		vres->v_num = qsquare(vp->v_num);
		return;
	case V_COM:
		vres->v_com = c_square(vp->v_com);
		c = vres->v_com;
		if (!cisreal(c))
			return;
		vres->v_num = qlink(c->real);
		vres->v_type = V_NUM;
		comfree(c);
		return;
	case V_MAT:
		vres->v_mat = matsquare(vp->v_mat);
		return;
	case V_OBJ:
		*vres = objcall(OBJ_SQUARE, vp, NULL_VALUE, NULL_VALUE);
		return;
	default:
		if (vp->v_type <= 0) {
			vres->v_type = vp->v_type;
			return;
		}
		*vres = error_value(E_SQUARE);
		return;
	}
}


/*
 * Invert an arbitrary value.
 * Result is placed in the indicated location.
 */
void
invertvalue(VALUE *vp, VALUE *vres)
{
	NUMBER *q1, *q2;

	vres->v_type = vp->v_type;
	vres->v_subtype = V_NOSUBTYPE;
	switch (vp->v_type) {
	case V_NUM:
		if (qiszero(vp->v_num))
			*vres = error_value(E_1OVER0);
		else
			vres->v_num = qinv(vp->v_num);
		return;
	case V_COM:
		vres->v_com = c_inv(vp->v_com);
		return;
	case V_MAT:
		vres->v_mat = matinv(vp->v_mat);
		return;
	case V_OCTET:
		if (*vp->v_octet == 0) {
			*vres = error_value(E_1OVER0);
			return;
		}
		q1 = itoq((long) *vp->v_octet);
		q2 = qinv(q1);
		qfree(q1);
		vres->v_num = q2;
		vres->v_type = V_NUM;
		return;
	case V_OBJ:
		*vres = objcall(OBJ_INV, vp, NULL_VALUE, NULL_VALUE);
		return;
	default:
		if (vp->v_type == -E_1OVER0) {
			vres->v_type = V_NUM;
			vres->v_num = qlink(&_qzero_);
			return;
		}
		if (vp->v_type <= 0)
			return;
		*vres = error_value(E_INV);
		return;
	}
}



/*
 * "AND" two arbitrary values together.
 * Result is placed in the indicated location.
 */
void
andvalue(VALUE *v1, VALUE *v2, VALUE *vres)
{
	vres->v_subtype = V_NOSUBTYPE;
	if (v1->v_type == V_NULL) {
		copyvalue(v2, vres);
		return;
	}
	if (v2->v_type == V_NULL) {
		copyvalue(v1, vres);