drygdryg/calc
1
0
Fork 0
mirror of https://github.com/lcn2/calc.git synced 2025-08-16 01:03:29 +03:00
Code Issues Packages Projects Releases Wiki Activity

Release calc version 2.11.2t1

Browse Source
This commit is contained in:
Landon Curt Noll
2000-12-15 07:34:07 -08:00
parent 5e098d2adf
commit 296aa50ac7
52 changed files with 1670 additions and 4777 deletions
Download Patch File Download Diff File Expand all files Collapse all files

226
value.c
View File

@@ -17,8 +17,8 @@
* 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.3 $
* @(#) $Id: value.c,v 29.3 2000/07/17 15:35:49 chongo Exp $
* @(#) $Revision: 29.2 $
* @(#) $Id: value.c,v 29.2 2000/06/07 14:02:13 chongo Exp $
* @(#) $Source: /usr/local/src/cmd/calc/RCS/value.c,v $
*
* Under source code control: 1990/02/15 01:48:25
@@ -57,10 +57,10 @@ freevalue(VALUE *vp)
type = vp->v_type;
vp->v_type = V_NULL;
vp->v_subtype = V_NOSUBTYPE;
if (type <= 0)
if (type < 0)
return;
switch (type) {
case V_NULL:
case V_ADDR:
case V_OCTET:
case V_NBLOCK:
@@ -111,6 +111,7 @@ freevalue(VALUE *vp)
math_error("Freeing unknown value type");
/*NOTREACHED*/
}
vp->v_subtype = V_NOSUBTYPE;
}
@@ -340,7 +341,7 @@ negvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_NEG, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type <= 0)
if (vp->v_type < 0)
return;
*vres = error_value(E_NEG);
return;
@@ -348,6 +349,76 @@ negvalue(VALUE *vp, VALUE *vres)
}
/*
* addnumeric - add two numeric values togethter
*
* If either value is not real or complex, it is assumed to have
* a value of 0.
*
* Result is placed in the indicated location.
*/
void
addnumeric(VALUE *v1, VALUE *v2, VALUE *vres)
{
COMPLEX *c;
/*
* add numeric values
*/
vres->v_subtype = V_NOSUBTYPE;
switch (TWOVAL(v1->v_type, v2->v_type)) {
case TWOVAL(V_NUM, V_NUM):
vres->v_num = qqadd(v1->v_num, v2->v_num);
vres->v_type = V_NUM;
return;
case TWOVAL(V_COM, V_NUM):
vres->v_com = caddq(v1->v_com, v2->v_num);
vres->v_type = V_COM;
return;
case TWOVAL(V_NUM, V_COM):
vres->v_com = caddq(v2->v_com, v1->v_num);
vres->v_type = V_COM;
return;
case TWOVAL(V_COM, V_COM):
vres->v_com = cadd(v1->v_com, v2->v_com);
vres->v_type = V_COM;
c = vres->v_com;
if (!cisreal(c))
return;
vres->v_num = qlink(c->real);
vres->v_type = V_NUM;
comfree(c);
return;
}
/*
* assume zero if a value is not numeric
*/
if (v1->v_type == V_NUM) {
/* v1 + 0 == v1 */
vres->v_type = v1->v_type;
vres->v_num = qlink(v1->v_num);
} else if (v1->v_type == V_COM) {
/* v1 + 0 == v1 */
vres->v_type = v1->v_type;
vres->v_com = clink(v1->v_com);
} else if (v2->v_type == V_NUM) {
/* v2 + 0 == v2 */
vres->v_type = v2->v_type;
vres->v_num = qlink(v2->v_num);
} else if (v2->v_type == V_COM) {
/* v2 + 0 == v2 */
vres->v_type = v2->v_type;
vres->v_com = clink(v2->v_com);
} else {
/* 0 + 0 = 0 */
vres->v_type = V_NUM;
vres->v_num = qlink(&_qzero_);
}
return;
}
/*
* Add two arbitrary values together.
* Result is placed in the indicated location.
@@ -431,12 +502,15 @@ addvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type < 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
if (v2->v_type > 0)
*vres = error_value(E_ADD);
else
vres->v_type = v2->v_type;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
*vres = error_value(E_ADD);
return;
}
*vres = objcall(OBJ_ADD, v1, v2, NULL_VALUE);
@@ -518,10 +592,12 @@ subvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
*vres = error_value(E_SUB);
@@ -583,10 +659,12 @@ mulvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
}
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
*vres = error_value(E_MUL);
@@ -635,8 +713,8 @@ squarevalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_SQUARE, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type <= 0) {
vres->v_type = vp->v_type;
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_SQUARE);
@@ -689,8 +767,10 @@ invertvalue(VALUE *vp, VALUE *vres)
vres->v_num = qlink(&_qzero_);
return;
}
if (vp->v_type <= 0)
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_INV);
return;
}
@@ -739,10 +819,12 @@ andvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type < 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v2->v_type < 0) {
vres->v_type = v2->v_type;
copyvalue(v2, vres);
return;
}
*vres = error_value(E_AND);
@@ -795,10 +877,12 @@ orvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
default:
if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
if (v1->v_type < 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v2->v_type < 0) {
vres->v_type = v2->v_type;
copyvalue(v2, vres);
return;
}
*vres = error_value(E_OR);
@@ -1013,9 +1097,10 @@ apprvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
e = NULL;
switch(v2->v_type) {
case V_NUM: e = v2->v_num;
@@ -1154,8 +1239,10 @@ roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_com = c;
return;
default:
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
*vres = error_value(E_ROUND);
return;
}
@@ -1240,8 +1327,10 @@ broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_com = c;
return;
default:
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
*vres = error_value(E_BROUND);
return;
}
@@ -1285,8 +1374,10 @@ intvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_INT, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type <= 0)
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_INT);
return;
}
@@ -1332,8 +1423,10 @@ fracvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_FRAC, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type < 0)
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_FRAC);
return;
}
@@ -1368,7 +1461,7 @@ incvalue(VALUE *vp, VALUE *vres)
vres->v_addr = vp->v_addr + 1;
break;
default:
if (vp->v_type > 0)
if (vp->v_type >= 0)
*vres = error_value(E_INCV);
break;
}
@@ -1440,8 +1533,8 @@ conjvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_CONJ, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type <= 0) {
vres->v_type = vp->v_type;
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_CONJ);
@@ -1467,8 +1560,8 @@ sqrtvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
}
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v2->v_type == V_NULL) {
@@ -1537,8 +1630,8 @@ rootvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
COMPLEX *c;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v2->v_type != V_NUM) {
@@ -1607,8 +1700,8 @@ absvalue(VALUE *v1, VALUE *v2, VALUE *vres)
return;
}
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
switch (v1->v_type) {
@@ -1646,8 +1739,8 @@ normvalue(VALUE *vp, VALUE *vres)
vres->v_type = vp->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (vp->v_type <= 0) {
vres->v_type = vp->v_type;
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
switch (vp->v_type) {
@@ -1693,8 +1786,8 @@ shiftvalue(VALUE *v1, VALUE *v2, BOOL rightshift, VALUE *vres)
VALUE tmp;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if ((v2->v_type != V_NUM) || (qisfrac(v2->v_num))) {
@@ -1779,8 +1872,8 @@ scalevalue(VALUE *v1, VALUE *v2, VALUE *vres)
long n = 0;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if ((v2->v_type != V_NUM) || qisfrac(v2->v_num)) {
@@ -1831,9 +1924,9 @@ powivalue(VALUE *v1, VALUE *v2, VALUE *vres)
}
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0 && v1->v_type != -E_1OVER0)
if (v1->v_type < 0 && v1->v_type != -E_1OVER0)
return;
if (v2->v_type <= 0) {
if (v2->v_type < 0) {
vres->v_type = v2->v_type;
return;
}
@@ -1889,8 +1982,8 @@ powervalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
COMPLEX *c, ctmp1, ctmp2;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0) {
vres->v_type = v1->v_type;
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v1->v_type != V_NUM && v1->v_type != V_COM) {
@@ -1970,9 +2063,9 @@ divvalue(VALUE *v1, VALUE *v2, VALUE *vres)
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0)
if (v1->v_type < 0)
return;
if (v2->v_type <= 0) {
if (v2->v_type < 0) {
if (testvalue(v1) && v2->v_type == -E_1OVER0) {
vres->v_type = V_NUM;
vres->v_num = qlink(&_qzero_);
@@ -2053,9 +2146,10 @@ quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
if (v1->v_type == V_MAT) {
vres->v_mat = matquoval(v1->v_mat, v2, v3);
return;
@@ -2068,8 +2162,8 @@ quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
*vres = objcall(OBJ_QUO, v1, v2, v3);
return;
}
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
if (v2->v_type != V_NUM) {
@@ -2130,11 +2224,12 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
NUMBER *q1, *q2;
long rnd;
vres->v_type = v1->v_type;
vres->v_subtype = V_NOSUBTYPE;
if (v1->v_type <= 0)
if (v1->v_type < 0) {
copyvalue(v1, vres);
return;
}
vres->v_type = v1->v_type;
if (v1->v_type == V_MAT) {
vres->v_mat = matmodval(v1->v_mat, v2, v3);
return;
@@ -2147,8 +2242,8 @@ modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
*vres = objcall(OBJ_MOD, v1, v2, v3);
return;
}
if (v2->v_type <= 0) {
vres->v_type = v2->v_type;
if (v2->v_type < 0) {
copyvalue(v2, vres);
return;
}
if (v2->v_type != V_NUM) {
@@ -2292,7 +2387,7 @@ comparevalue(VALUE *v1, VALUE *v2)
return comparevalue(v2, v1);
if (v1->v_type != v2->v_type)
return TRUE;
if (v1->v_type <= 0)
if (v1->v_type < 0)
return FALSE;
switch (v1->v_type) {
case V_NUM:
@@ -2313,6 +2408,8 @@ comparevalue(VALUE *v1, VALUE *v2)
case V_ASSOC:
r = assoccmp(v1->v_assoc, v2->v_assoc);
break;
case V_NULL:
break;
case V_FILE:
r = (v1->v_file != v2->v_file);
break;
@@ -2600,8 +2697,11 @@ sgnvalue(VALUE *vp, VALUE *vres)
*vres = objcall(OBJ_SGN, vp, NULL_VALUE, NULL_VALUE);
return;
default:
if (vp->v_type > 0)
*vres = error_value(E_SGN);
if (vp->v_type < 0) {
copyvalue(vp, vres);
return;
}
*vres = error_value(E_SGN);
return;
}
}
@@ -2755,7 +2855,7 @@ config_print(CONFIG *cfg)
*/
if (cfg == NULL || cfg->epsilon == NULL || cfg->prompt1 == NULL ||
cfg->prompt2 == NULL) {
math_error("CONFIG value is invalid");
math_error("CONFIG value is invaid");
/*NOTREACHED*/
}