1 /*
2  * value - generic value manipulation routines
3  *
4  * Copyright (C) 1999-2007,2014,2017,2021  David I. Bell
5  *
6  * Calc is open software; you can redistribute it and/or modify it under
7  * the terms of the version 2.1 of the GNU Lesser General Public License
8  * as published by the Free Software Foundation.
9  *
10  * Calc is distributed in the hope that it will be useful, but WITHOUT
11  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12  * or FITNESS FOR A PARTICULAR PURPOSE.	 See the GNU Lesser General
13  * Public License for more details.
14  *
15  * A copy of version 2.1 of the GNU Lesser General Public License is
16  * distributed with calc under the filename COPYING-LGPL.  You should have
17  * received a copy with calc; if not, write to Free Software Foundation, Inc.
18  * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
19  *
20  * Under source code control:	1990/02/15 01:48:25
21  * File existed as early as:	before 1990
22  *
23  * Share and enjoy!  :-)	http://www.isthe.com/chongo/tech/comp/calc/
24  */
25 
26 
27 #include <stdio.h>
28 #include <sys/types.h>
29 #include "value.h"
30 #include "opcodes.h"
31 #include "func.h"
32 #include "symbol.h"
33 #include "str.h"
34 #include "zrand.h"
35 #include "zrandom.h"
36 #include "cmath.h"
37 #include "nametype.h"
38 #include "file.h"
39 #include "config.h"
40 
41 
42 #include "banned.h"	/* include after system header <> includes */
43 
44 
45 #define LINELEN 80		/* length of a typical tty line */
46 
47 /*
48  * Free a value and set its type to undefined.
49  *
50  * given:
51  *	vp		value to be freed
52  */
53 void
freevalue(VALUE * vp)54 freevalue(VALUE *vp)
55 {
56 	int type;		/* type of value being freed */
57 
58 	type = vp->v_type;
59 	vp->v_type = V_NULL;
60 	vp->v_subtype = V_NOSUBTYPE;
61 	if (type <= 0)
62 		return;
63 	switch (type) {
64 	case V_ADDR:
65 	case V_OCTET:
66 	case V_NBLOCK:
67 	case V_FILE:
68 	case V_VPTR:
69 	case V_OPTR:
70 	case V_SPTR:
71 	case V_NPTR:
72 		/* nothing to free */
73 		break;
74 	case V_STR:
75 		sfree(vp->v_str);
76 		break;
77 	case V_NUM:
78 		qfree(vp->v_num);
79 		break;
80 	case V_COM:
81 		comfree(vp->v_com);
82 		break;
83 	case V_MAT:
84 		matfree(vp->v_mat);
85 		break;
86 	case V_LIST:
87 		listfree(vp->v_list);
88 		break;
89 	case V_ASSOC:
90 		assocfree(vp->v_assoc);
91 		break;
92 	case V_OBJ:
93 		objfree(vp->v_obj);
94 		break;
95 	case V_RAND:
96 		randfree(vp->v_rand);
97 		break;
98 	case V_RANDOM:
99 		randomfree(vp->v_random);
100 		break;
101 	case V_CONFIG:
102 		config_free(vp->v_config);
103 		break;
104 	case V_HASH:
105 		hash_free(vp->v_hash);
106 		break;
107 	case V_BLOCK:
108 		blk_free(vp->v_block);
109 		break;
110 	default:
111 		math_error("Freeing unknown value type");
112 		/*NOTREACHED*/
113 	}
114 }
115 
116 
117 /*
118  * Set protection status for a value and all of its components
119  */
120 void
protecttodepth(VALUE * vp,int sts,int depth)121 protecttodepth(VALUE *vp, int sts, int depth)
122 {
123 	VALUE *vq;
124 	int i;
125 	LISTELEM *ep;
126 	ASSOC *ap;
127 
128 	if (vp->v_type == V_NBLOCK) {
129 		if (sts > 0)
130 			vp->v_nblock->subtype |= sts;
131 		else if (sts < 0)
132 			vp->v_nblock->subtype &= ~(-sts);
133 		else vp->v_nblock->subtype = 0;
134 		return;
135 	}
136 	if (sts > 0)
137 		vp->v_subtype |= sts;
138 	else if (sts < 0)
139 		vp->v_subtype &= ~(-sts);
140 	else
141 		vp->v_subtype = 0;
142 
143 
144 	if (depth > 0) {
145 	    switch(vp->v_type) {
146 	    case V_MAT:
147 		    vq = vp->v_mat->m_table;
148 		    i = vp->v_mat->m_size;
149 		    while (i-- > 0)
150 			    protecttodepth(vq++, sts, depth - 1);
151 		    break;
152 	    case V_LIST:
153 		    for (ep = vp->v_list->l_first; ep; ep = ep->e_next)
154 			    protecttodepth(&ep->e_value, sts, depth - 1);
155 		    break;
156 	    case V_OBJ:
157 		    vq = vp->v_obj->o_table;
158 		    i = vp->v_obj->o_actions->oa_count;
159 		    while (i-- > 0)
160 			    protecttodepth(vq++, sts, depth - 1);
161 		    break;
162 	    case V_ASSOC:
163 		    ap = vp->v_assoc;
164 		    for (i = 0; i < ap->a_count; i++)
165 			    protecttodepth(assocfindex(ap, i), sts, depth - 1);
166 	    }
167 	}
168 }
169 
170 
171 /*
172  * Copy a value from one location to another.
173  * This overwrites the specified new value without checking it.
174  *
175  * given:
176  *	oldvp		value to be copied from
177  *	newvp		value to be copied into
178  */
179 void
copyvalue(VALUE * oldvp,VALUE * newvp)180 copyvalue(VALUE *oldvp, VALUE *newvp)
181 {
182 	/* firewall */
183 	if (oldvp == NULL)
184 		return;
185 
186 	newvp->v_type = oldvp->v_type;
187 	if (oldvp->v_type >= 0) {
188 		switch (oldvp->v_type) {
189 		case V_NULL:
190 		case V_ADDR:
191 		case V_VPTR:
192 		case V_OPTR:
193 		case V_SPTR:
194 		case V_NPTR:
195 			*newvp = *oldvp;
196 			break;
197 		case V_FILE:
198 			newvp->v_file = oldvp->v_file;
199 			break;
200 		case V_NUM:
201 			newvp->v_num = qlink(oldvp->v_num);
202 			break;
203 		case V_COM:
204 			newvp->v_com = clink(oldvp->v_com);
205 			break;
206 		case V_STR:
207 			newvp->v_str = slink(oldvp->v_str);
208 			break;
209 		case V_MAT:
210 			newvp->v_mat = matcopy(oldvp->v_mat);
211 			break;
212 		case V_LIST:
213 			newvp->v_list = listcopy(oldvp->v_list);
214 			break;
215 		case V_ASSOC:
216 			newvp->v_assoc = assoccopy(oldvp->v_assoc);
217 			break;
218 		case V_OBJ:
219 			newvp->v_obj = objcopy(oldvp->v_obj);
220 			break;
221 		case V_RAND:
222 			newvp->v_rand = randcopy(oldvp->v_rand);
223 			break;
224 		case V_RANDOM:
225 			newvp->v_random = randomcopy(oldvp->v_random);
226 			break;
227 		case V_CONFIG:
228 			newvp->v_config = config_copy(oldvp->v_config);
229 			break;
230 		case V_HASH:
231 			newvp->v_hash = hash_copy(oldvp->v_hash);
232 			break;
233 		case V_BLOCK:
234 			newvp->v_block = blk_copy(oldvp->v_block);
235 			break;
236 		case V_OCTET:
237 			newvp->v_type = V_NUM;
238 			newvp->v_num = itoq((long) *oldvp->v_octet);
239 			break;
240 		case V_NBLOCK:
241 			newvp->v_nblock = oldvp->v_nblock;
242 			break;
243 		default:
244 			math_error("Copying unknown value type");
245 			/*NOTREACHED*/
246 		}
247 	}
248 	newvp->v_subtype = oldvp->v_subtype;
249 }
250 
251 
252 /*
253  * copy the low order 8 bits of a value to an octet
254  */
255 void
copy2octet(VALUE * vp,OCTET * op)256 copy2octet(VALUE *vp, OCTET *op)
257 {
258 	USB8 oval;	/* low order 8 bits to store into OCTET */
259 	NUMBER *q;
260 	HALF h;
261 
262 	if (vp->v_type == V_ADDR)
263 		vp = vp->v_addr;
264 
265 	oval = 0;
266 
267 	/*
268 	 * we can (at the moment) only store certain types
269 	 * values into an OCTET, so get the low order 8 bits
270 	 * of these particular value types
271 	 */
272 	h = 0;
273 	switch(vp->v_type) {
274 	case V_NULL:
275 		/* nothing to store ... so do nothing */
276 		return;
277 	case V_INT:
278 		oval = (USB8)(vp->v_int & 0xff);
279 		break;
280 	case V_NUM:
281 		if (qisint(vp->v_num)) {
282 			/* use low order 8 bits of integer value */
283 			h = vp->v_num->num.v[0];
284 		} else {
285 			/* use low order 8 bits of int(value) */
286 			q = qint(vp->v_num);
287 			h = q->num.v[0];
288 			qfree(q);
289 		}
290 		if (qisneg(vp->v_num))
291 			h = -h;
292 		oval = (USB8) h;
293 		break;
294 	case V_COM:
295 		if (cisint(vp->v_com)) {
296 			/* use low order 8 bits of integer value */
297 			h = vp->v_com->real->num.v[0];
298 		} else {
299 			/* use low order 8 bits of int(value) */
300 			q = qint(vp->v_com->real);
301 			h = q->num.v[0];
302 			qfree(q);
303 		}
304 		if (qisneg(vp->v_com->real))
305 			h = -h;
306 		oval = (USB8) h;
307 		break;
308 	case V_STR:
309 		oval = (USB8) vp->v_str->s_str[0];
310 		break;
311 	case V_BLOCK:
312 		oval = (USB8) vp->v_block->data[0];
313 		break;
314 	case V_OCTET:
315 		oval = *vp->v_octet;
316 		break;
317 	case V_NBLOCK:
318 		if (vp->v_nblock->blk->data == NULL)
319 			return;
320 		oval = (USB8) vp->v_nblock->blk->data[0];
321 		break;
322 	default:
323 		math_error("invalid assignment into an OCTET");
324 		break;
325 	}
326 	*op = oval;
327 }
328 
329 
330 /*
331  * Negate an arbitrary value.
332  * Result is placed in the indicated location.
333  */
334 void
negvalue(VALUE * vp,VALUE * vres)335 negvalue(VALUE *vp, VALUE *vres)
336 {
337 	vres->v_type = vp->v_type;
338 	vres->v_subtype = V_NOSUBTYPE;
339 	switch (vp->v_type) {
340 	case V_NUM:
341 		vres->v_num = qneg(vp->v_num);
342 		return;
343 	case V_COM:
344 		vres->v_com = c_neg(vp->v_com);
345 		return;
346 	case V_MAT:
347 		vres->v_mat = matneg(vp->v_mat);
348 		return;
349 	case V_STR:
350 		vres->v_str = stringneg(vp->v_str);
351 		if (vres->v_str == NULL)
352 			*vres = error_value(E_STRNEG);
353 		return;
354 	case V_OCTET:
355 		vres->v_type = V_NUM;
356 		vres->v_subtype = V_NOSUBTYPE;
357 		vres->v_num = itoq(- (long) *vp->v_octet);
358 		return;
359 
360 	case V_OBJ:
361 		*vres = objcall(OBJ_NEG, vp, NULL_VALUE, NULL_VALUE);
362 		return;
363 	default:
364 		if (vp->v_type <= 0)
365 			return;
366 		*vres = error_value(E_NEG);
367 		return;
368 	}
369 }
370 
371 
372 /*
373  * Add two arbitrary values together.
374  * Result is placed in the indicated location.
375  */
376 void
addvalue(VALUE * v1,VALUE * v2,VALUE * vres)377 addvalue(VALUE *v1, VALUE *v2, VALUE *vres)
378 {
379 	COMPLEX *c;
380 	VALUE tmp;
381 	NUMBER *q;
382 	long i;
383 
384 	vres->v_subtype = V_NOSUBTYPE;
385 	if (v1->v_type == V_LIST) {
386 		tmp.v_type = V_NULL;
387 		addlistitems(v1->v_list, &tmp);
388 		addvalue(&tmp, v2, vres);
389 		return;
390 	}
391 	if (v2->v_type == V_LIST) {
392 		copyvalue(v1, vres);
393 		addlistitems(v2->v_list, vres);
394 		return;
395 	}
396 	if (v1->v_type == V_NULL) {
397 		copyvalue(v2, vres);
398 		return;
399 	}
400 	if (v2->v_type == V_NULL) {
401 		copyvalue(v1, vres);
402 		return;
403 	}
404 	vres->v_type = v1->v_type;
405 	switch (TWOVAL(v1->v_type, v2->v_type)) {
406 	case TWOVAL(V_NUM, V_NUM):
407 		vres->v_num = qqadd(v1->v_num, v2->v_num);
408 		return;
409 	case TWOVAL(V_COM, V_NUM):
410 		vres->v_com = c_addq(v1->v_com, v2->v_num);
411 		return;
412 	case TWOVAL(V_NUM, V_COM):
413 		vres->v_com = c_addq(v2->v_com, v1->v_num);
414 		vres->v_type = V_COM;
415 		return;
416 	case TWOVAL(V_COM, V_COM):
417 		vres->v_com = c_add(v1->v_com, v2->v_com);
418 		c = vres->v_com;
419 		if (!cisreal(c))
420 			return;
421 		vres->v_num = qlink(c->real);
422 		vres->v_type = V_NUM;
423 		comfree(c);
424 		return;
425 	case TWOVAL(V_MAT, V_MAT):
426 		vres->v_mat = matadd(v1->v_mat, v2->v_mat);
427 		return;
428 	case TWOVAL(V_STR, V_STR):
429 		vres->v_str = stringadd(v1->v_str, v2->v_str);
430 		if (vres->v_str == NULL)
431 			*vres = error_value(E_STRADD);
432 		return;
433 	case TWOVAL(V_VPTR, V_NUM):
434 		q = v2->v_num;
435 		if (qisfrac(q)) {
436 			math_error("Adding non-integer to address");
437 			/*NOTREACHED*/
438 		}
439 		i = qtoi(q);
440 		vres->v_addr = v1->v_addr + i;
441 		vres->v_type = V_VPTR;
442 		return;
443 	case TWOVAL(V_OPTR, V_NUM):
444 		q = v2->v_num;
445 		if (qisfrac(q)) {
446 			math_error("Adding non-integer to address");
447 			/*NOTREACHED*/
448 		}
449 		i = qtoi(q);
450 		vres->v_octet = v1->v_octet + i;
451 		vres->v_type = V_OPTR;
452 		return;
453 	default:
454 		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
455 			if (v1->v_type < 0)
456 				return;
457 			if (v2->v_type > 0)
458 				*vres = error_value(E_ADD);
459 			else
460 				vres->v_type = v2->v_type;
461 			return;
462 		}
463 		*vres = objcall(OBJ_ADD, v1, v2, NULL_VALUE);
464 		return;
465 	}
466 }
467 
468 
469 /*
470  * Subtract one arbitrary value from another one.
471  * Result is placed in the indicated location.
472  */
473 void
subvalue(VALUE * v1,VALUE * v2,VALUE * vres)474 subvalue(VALUE *v1, VALUE *v2, VALUE *vres)
475 {
476 	COMPLEX *c;
477 	NUMBER *q;
478 	int i;
479 
480 	vres->v_type = v1->v_type;
481 	vres->v_subtype = V_NOSUBTYPE;
482 	switch (TWOVAL(v1->v_type, v2->v_type)) {
483 	case TWOVAL(V_NUM, V_NUM):
484 		vres->v_num = qsub(v1->v_num, v2->v_num);
485 		return;
486 	case TWOVAL(V_COM, V_NUM):
487 		vres->v_com = c_subq(v1->v_com, v2->v_num);
488 		return;
489 	case TWOVAL(V_NUM, V_COM):
490 		c = c_subq(v2->v_com, v1->v_num);
491 		vres->v_type = V_COM;
492 		vres->v_com = c_neg(c);
493 		comfree(c);
494 		return;
495 	case TWOVAL(V_COM, V_COM):
496 		vres->v_com = c_sub(v1->v_com, v2->v_com);
497 		c = vres->v_com;
498 		if (!cisreal(c))
499 			return;
500 		vres->v_num = qlink(c->real);
501 		vres->v_type = V_NUM;
502 		comfree(c);
503 		return;
504 	case TWOVAL(V_MAT, V_MAT):
505 		vres->v_mat = matsub(v1->v_mat, v2->v_mat);
506 		return;
507 	case TWOVAL(V_STR, V_STR):
508 		vres->v_str = stringsub(v1->v_str, v2->v_str);
509 		if (vres->v_str == NULL)
510 			*vres = error_value(E_STRSUB);
511 		return;
512 	case TWOVAL(V_VPTR, V_NUM):
513 		q = v2->v_num;
514 		if (qisfrac(q)) {
515 			math_error("Subtracting non-integer from address");
516 			/*NOTREACHED*/
517 		}
518 		i = qtoi(q);
519 		vres->v_addr = v1->v_addr - i;
520 		vres->v_type = V_VPTR;
521 		return;
522 	case TWOVAL(V_OPTR, V_NUM):
523 		q = v2->v_num;
524 		if (qisfrac(q)) {
525 			math_error("Adding non-integer to address");
526 			/*NOTREACHED*/
527 		}
528 		i = qtoi(q);
529 		vres->v_octet = v1->v_octet - i;
530 		vres->v_type = V_OPTR;
531 		return;
532 	case TWOVAL(V_VPTR, V_VPTR):
533 		vres->v_type = V_NUM;
534 		vres->v_num = itoq(v1->v_addr - v2->v_addr);
535 		return;
536 	case TWOVAL(V_OPTR, V_OPTR):
537 		vres->v_type = V_NUM;
538 		vres->v_num = itoq(v1->v_octet - v2->v_octet);
539 		return;
540 	default:
541 		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
542 			if (v1->v_type <= 0)
543 				return;
544 			if (v2->v_type <= 0) {
545 				vres->v_type = v2->v_type;
546 				return;
547 			}
548 			*vres = error_value(E_SUB);
549 			return;
550 		}
551 		*vres = objcall(OBJ_SUB, v1, v2, NULL_VALUE);
552 		return;
553 	}
554 }
555 
556 
557 /*
558  * Multiply two arbitrary values together.
559  * Result is placed in the indicated location.
560  */
561 void
mulvalue(VALUE * v1,VALUE * v2,VALUE * vres)562 mulvalue(VALUE *v1, VALUE *v2, VALUE *vres)
563 {
564 	COMPLEX *c;
565 
566 	vres->v_type = v1->v_type;
567 	vres->v_subtype = V_NOSUBTYPE;
568 	switch (TWOVAL(v1->v_type, v2->v_type)) {
569 	case TWOVAL(V_NUM, V_NUM):
570 		vres->v_num = qmul(v1->v_num, v2->v_num);
571 		return;
572 	case TWOVAL(V_COM, V_NUM):
573 		vres->v_com = c_mulq(v1->v_com, v2->v_num);
574 		break;
575 	case TWOVAL(V_NUM, V_COM):
576 		vres->v_com = c_mulq(v2->v_com, v1->v_num);
577 		vres->v_type = V_COM;
578 		break;
579 	case TWOVAL(V_COM, V_COM):
580 		vres->v_com = c_mul(v1->v_com, v2->v_com);
581 		break;
582 	case TWOVAL(V_MAT, V_MAT):
583 		vres->v_mat = matmul(v1->v_mat, v2->v_mat);
584 		return;
585 	case TWOVAL(V_MAT, V_NUM):
586 	case TWOVAL(V_MAT, V_COM):
587 		vres->v_mat = matmulval(v1->v_mat, v2);
588 		return;
589 	case TWOVAL(V_NUM, V_MAT):
590 	case TWOVAL(V_COM, V_MAT):
591 		vres->v_mat = matmulval(v2->v_mat, v1);
592 		vres->v_type = V_MAT;
593 		return;
594 	case TWOVAL(V_NUM, V_STR):
595 		vres->v_type = V_STR;
596 		vres->v_str = stringmul(v1->v_num, v2->v_str);
597 		if (vres->v_str == NULL)
598 			*vres = error_value(E_STRMUL);
599 		return;
600 	case TWOVAL(V_STR, V_NUM):
601 		vres->v_str= stringmul(v2->v_num, v1->v_str);
602 		if (vres->v_str == NULL)
603 			*vres = error_value(E_STRMUL);
604 		return;
605 	default:
606 		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
607 			if (v1->v_type <= 0)
608 				return;
609 			if (v2->v_type <= 0) {
610 				vres->v_type = v2->v_type;
611 				return;
612 			}
613 			*vres = error_value(E_MUL);
614 			return;
615 		}
616 		*vres = objcall(OBJ_MUL, v1, v2, NULL_VALUE);
617 		return;
618 	}
619 	c = vres->v_com;
620 	if (cisreal(c)) {
621 		vres->v_num = qlink(c->real);
622 		vres->v_type = V_NUM;
623 		comfree(c);
624 	}
625 }
626 
627 
628 /*
629  * Square an arbitrary value.
630  * Result is placed in the indicated location.
631  */
632 void
squarevalue(VALUE * vp,VALUE * vres)633 squarevalue(VALUE *vp, VALUE *vres)
634 {
635 	COMPLEX *c;
636 
637 	vres->v_type = vp->v_type;
638 	vres->v_subtype = V_NOSUBTYPE;
639 	switch (vp->v_type) {
640 	case V_NUM:
641 		vres->v_num = qsquare(vp->v_num);
642 		return;
643 	case V_COM:
644 		vres->v_com = c_square(vp->v_com);
645 		c = vres->v_com;
646 		if (!cisreal(c))
647 			return;
648 		vres->v_num = qlink(c->real);
649 		vres->v_type = V_NUM;
650 		comfree(c);
651 		return;
652 	case V_MAT:
653 		vres->v_mat = matsquare(vp->v_mat);
654 		return;
655 	case V_OBJ:
656 		*vres = objcall(OBJ_SQUARE, vp, NULL_VALUE, NULL_VALUE);
657 		return;
658 	default:
659 		if (vp->v_type <= 0) {
660 			vres->v_type = vp->v_type;
661 			return;
662 		}
663 		*vres = error_value(E_SQUARE);
664 		return;
665 	}
666 }
667 
668 
669 /*
670  * Invert an arbitrary value.
671  * Result is placed in the indicated location.
672  */
673 void
invertvalue(VALUE * vp,VALUE * vres)674 invertvalue(VALUE *vp, VALUE *vres)
675 {
676 	NUMBER *q1, *q2;
677 
678 	vres->v_type = vp->v_type;
679 	vres->v_subtype = V_NOSUBTYPE;
680 	switch (vp->v_type) {
681 	case V_NUM:
682 		if (qiszero(vp->v_num))
683 			*vres = error_value(E_1OVER0);
684 		else
685 			vres->v_num = qinv(vp->v_num);
686 		return;
687 	case V_COM:
688 		vres->v_com = c_inv(vp->v_com);
689 		return;
690 	case V_MAT:
691 		vres->v_mat = matinv(vp->v_mat);
692 		return;
693 	case V_OCTET:
694 		if (*vp->v_octet == 0) {
695 			*vres = error_value(E_1OVER0);
696 			return;
697 		}
698 		q1 = itoq((long) *vp->v_octet);
699 		q2 = qinv(q1);
700 		qfree(q1);
701 		vres->v_num = q2;
702 		vres->v_type = V_NUM;
703 		return;
704 	case V_OBJ:
705 		*vres = objcall(OBJ_INV, vp, NULL_VALUE, NULL_VALUE);
706 		return;
707 	default:
708 		if (vp->v_type == -E_1OVER0) {
709 			vres->v_type = V_NUM;
710 			vres->v_num = qlink(&_qzero_);
711 			return;
712 		}
713 		if (vp->v_type <= 0)
714 			return;
715 		*vres = error_value(E_INV);
716 		return;
717 	}
718 }
719 
720 
721 
722 /*
723  * "AND" two arbitrary values together.
724  * Result is placed in the indicated location.
725  */
726 void
andvalue(VALUE * v1,VALUE * v2,VALUE * vres)727 andvalue(VALUE *v1, VALUE *v2, VALUE *vres)
728 {
729 	vres->v_subtype = V_NOSUBTYPE;
730 	if (v1->v_type == V_NULL) {
731 		copyvalue(v2, vres);
732 		return;
733 	}
734 	if (v2->v_type == V_NULL) {
735 		copyvalue(v1, vres);
736 		return;
737 	}
738 	vres->v_type = v1->v_type;
739 	switch (TWOVAL(v1->v_type, v2->v_type)) {
740 	case TWOVAL(V_NUM, V_NUM):
741 		vres->v_num = qand(v1->v_num, v2->v_num);
742 		return;
743 	case TWOVAL(V_STR, V_STR):
744 		vres->v_str = stringand(v1->v_str, v2->v_str);
745 		if (vres->v_str == NULL)
746 			*vres = error_value(E_STRAND);
747 		return;
748 	case TWOVAL(V_OCTET, V_OCTET):
749 		vres->v_type = V_STR;
750 		vres->v_str = charstring(*v1->v_octet & *v2->v_octet);
751 		return;
752 	case TWOVAL(V_STR, V_OCTET):
753 		vres->v_str = charstring(*v1->v_str->s_str &
754 					*v2->v_octet);
755 		return;
756 	case TWOVAL(V_OCTET, V_STR):
757 		vres->v_type = V_STR;
758 		vres->v_str = charstring(*v1->v_octet &
759 					*v2->v_str->s_str);
760 		return;
761 	default:
762 		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
763 			if (v1->v_type < 0)
764 				return;
765 			if (v2->v_type < 0) {
766 				vres->v_type = v2->v_type;
767 				return;
768 			}
769 			*vres = error_value(E_AND);
770 			return;
771 		}
772 		*vres = objcall(OBJ_AND, v1, v2, NULL_VALUE);
773 		return;
774 	}
775 }
776 
777 
778 /*
779  * "OR" two arbitrary values together.
780  * Result is placed in the indicated location.
781  */
782 void
orvalue(VALUE * v1,VALUE * v2,VALUE * vres)783 orvalue(VALUE *v1, VALUE *v2, VALUE *vres)
784 {
785 	if (v1->v_type == V_NULL) {
786 		copyvalue(v2, vres);
787 		return;
788 	}
789 	if (v2->v_type == V_NULL) {
790 		copyvalue(v1, vres);
791 		return;
792 	}
793 	vres->v_type = v1->v_type;
794 	vres->v_subtype = V_NOSUBTYPE;
795 	switch (TWOVAL(v1->v_type, v2->v_type)) {
796 	case TWOVAL(V_NUM, V_NUM):
797 		vres->v_num = qor(v1->v_num, v2->v_num);
798 		return;
799 	case TWOVAL(V_STR, V_STR):
800 		vres->v_str = stringor(v1->v_str, v2->v_str);
801 		if (vres->v_str == NULL)
802 			*vres = error_value(E_STROR);
803 		return;
804 	case TWOVAL(V_OCTET, V_OCTET):
805 		vres->v_type = V_STR;
806 		vres->v_str = charstring(*v1->v_octet | *v2->v_octet);
807 		return;
808 	case TWOVAL(V_STR, V_OCTET):
809 		vres->v_str = charstring(*v1->v_str->s_str |
810 				*v2->v_octet);
811 		return;
812 	case TWOVAL(V_OCTET, V_STR):
813 		vres->v_type = V_STR;
814 		vres->v_str = charstring(*v1->v_octet |
815 				*v2->v_str->s_str);
816 		return;
817 	default:
818 		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
819 			if (v1->v_type < 0)
820 				return;
821 			if (v2->v_type < 0) {
822 				vres->v_type = v2->v_type;
823 				return;
824 			}
825 			*vres = error_value(E_OR);
826 			return;
827 		}
828 		*vres = objcall(OBJ_OR, v1, v2, NULL_VALUE);
829 		return;
830 	}
831 }
832 
833 
834 /*
835  * "~" two values, returns the "symmetric difference" bitwise xor(v1, v2) for
836  * strings, octets and real numbers, and a user-defined function if at least
837  * one of v1 and v2 is an object.
838  */
839 void
xorvalue(VALUE * v1,VALUE * v2,VALUE * vres)840 xorvalue(VALUE *v1, VALUE *v2, VALUE *vres)
841 {
842 	vres->v_type = v1->v_type;
843 	vres->v_subtype = V_NOSUBTYPE;
844 	switch (TWOVAL(v1->v_type, v2->v_type)) {
845 	case (TWOVAL(V_NUM, V_NUM)):
846 		vres->v_num = qxor(v1->v_num, v2->v_num);
847 		return;
848 	case (TWOVAL(V_STR, V_STR)):
849 		vres->v_str = stringxor(v1->v_str, v2->v_str);
850 		if (vres->v_str == NULL)
851 			*vres = error_value(E_STRDIFF);
852 		return;
853 	case (TWOVAL(V_STR, V_OCTET)):
854 		if (v1->v_str->s_len) {
855 			vres->v_str = stringcopy(v1->v_str);
856 			*vres->v_str->s_str ^= *v2->v_octet;
857 		} else {
858 			vres->v_str = charstring(*v2->v_octet);
859 		}
860 		return;
861 	case (TWOVAL(V_OCTET, V_STR)):
862 		if (v2->v_str->s_len) {
863 			vres->v_str = stringcopy(v2->v_str);
864 			*vres->v_str->s_str ^= *v1->v_octet;
865 		} else {
866 			vres->v_str = charstring(*v1->v_octet);
867 		}
868 		return;
869 	case (TWOVAL(V_OCTET, V_OCTET)):
870 		vres->v_type = V_STR;
871 		vres->v_str = charstring(*v1->v_octet ^ *v2->v_octet);
872 		return;
873 	default:
874 		if (v1->v_type == V_OBJ || v2->v_type == V_OBJ)
875 			*vres = objcall(OBJ_XOR, v1, v2, NULL_VALUE);
876 		else
877 			*vres = error_value(E_XOR);
878 	}
879 }
880 
881 
882 /*
883  * "#" two values - abs(v1-v2) for numbers, user-defined for objects
884  */
885 void
hashopvalue(VALUE * v1,VALUE * v2,VALUE * vres)886 hashopvalue(VALUE *v1, VALUE *v2, VALUE *vres)
887 {
888 	NUMBER *q;
889 
890 	vres->v_type = v1->v_type;
891 	vres->v_subtype = V_NOSUBTYPE;
892 	switch (TWOVAL(v1->v_type, v2->v_type)) {
893 	case TWOVAL(V_NUM, V_NUM):
894 		q = qsub(v1->v_num, v2->v_num);
895 		vres->v_num = qqabs(q);
896 		qfree(q);
897 		return;
898 	default:
899 		if (v1->v_type == V_OBJ || v2->v_type == V_OBJ)
900 			*vres = objcall(OBJ_HASHOP, v1, v2, NULL_VALUE);
901 		else
902 			*vres = error_value(E_HASHOP);
903 	}
904 }
905 
906 
907 void
compvalue(VALUE * vp,VALUE * vres)908 compvalue(VALUE *vp, VALUE *vres)
909 {
910 
911 	vres->v_type = vp->v_type;
912 	vres->v_subtype = V_NOSUBTYPE;
913 	switch (vp->v_type) {
914 	case V_NUM:
915 		vres->v_num = qcomp(vp->v_num);
916 		return;
917 	case V_STR:
918 		vres->v_str = stringcomp(vp->v_str);
919 		if (vres->v_str == NULL)
920 			*vres = error_value(E_STRCOMP);
921 		return;
922 	case V_OCTET:
923 		vres->v_type = V_STR;
924 		vres->v_str = charstring(~*vp->v_octet);
925 		return;
926 	case V_OBJ:
927 		*vres = objcall(OBJ_COMP, vp, NULL_VALUE, NULL_VALUE);
928 		return;
929 	default:
930 		*vres = error_value(E_COMP);
931 	}
932 }
933 
934 /*
935  * "\" a value, user-defined only
936  */
937 void
backslashvalue(VALUE * vp,VALUE * vres)938 backslashvalue(VALUE *vp, VALUE *vres)
939 {
940 	if (vp->v_type == V_OBJ)
941 		*vres = objcall(OBJ_BACKSLASH, vp, NULL_VALUE, NULL_VALUE);
942 	else
943 		*vres = error_value(E_BACKSLASH);
944 }
945 
946 
947 /*
948  * "\" two values, for strings performs bitwise "AND-NOT" operation
949  * User defined for objects
950  */
951 void
setminusvalue(VALUE * v1,VALUE * v2,VALUE * vres)952 setminusvalue(VALUE *v1, VALUE *v2, VALUE *vres)
953 {
954 	vres->v_type = v1->v_type;
955 	vres->v_subtype = V_NOSUBTYPE;
956 	switch (TWOVAL(v1->v_type, v2->v_type)) {
957 	case TWOVAL(V_NUM, V_NUM):
958 		vres->v_num = qandnot(v1->v_num, v2->v_num);
959 		return;
960 	case TWOVAL(V_STR, V_STR):
961 		vres->v_str = stringdiff(v1->v_str, v2->v_str);
962 		return;
963 	case TWOVAL(V_STR, V_OCTET):
964 		vres->v_str = charstring(*v1->v_str->s_str &
965 			~*v2->v_octet);
966 		return;
967 	case TWOVAL(V_OCTET, V_STR):
968 		vres->v_type = V_STR;
969 		vres->v_str = charstring(*v1->v_octet &
970 			~*v2->v_str->s_str);
971 		return;
972 	case TWOVAL(V_OCTET, V_OCTET):
973 		vres->v_type = V_STR;
974 		vres->v_str = charstring(*v1->v_octet &
975 			~*v2->v_octet);
976 		return;
977 	default:
978 		if (v1->v_type == V_OBJ || v2->v_type == V_OBJ)
979 			*vres = objcall(OBJ_SETMINUS, v1, v2,
980 				NULL_VALUE);
981 		else
982 			*vres = error_value(E_SETMINUS);
983 	}
984 }
985 
986 
987 /*
988  * "#" a value, for strings and octets returns the number of nonzero bits
989  * in the value; user-defined for an object
990  */
991 void
contentvalue(VALUE * vp,VALUE * vres)992 contentvalue(VALUE *vp, VALUE *vres)
993 {
994 	long count;
995 	unsigned char u;
996 
997 	vres->v_type = V_NUM;
998 	vres->v_subtype = V_NOSUBTYPE;
999 	count = 0;
1000 	switch (vp->v_type) {
1001 	case V_STR:
1002 		count = stringcontent(vp->v_str);
1003 		break;
1004 	case V_OCTET:
1005 		for (u = *vp->v_octet; u; u >>= 1)
1006 			count += (u & 1);
1007 		break;
1008 	case V_NUM:
1009 		count = zpopcnt(vp->v_num->num, 1);
1010 		break;
1011 	case V_OBJ:
1012 		*vres = objcall(OBJ_CONTENT, vp, NULL_VALUE,
1013 			NULL_VALUE);
1014 		return;
1015 	default:
1016 		*vres = error_value(E_CONTENT);
1017 		return;
1018 	}
1019 	vres->v_num = itoq(count);
1020 }
1021 
1022 
1023 /*
1024  * Approximate numbers by multiples of v2 using rounding criterion v3.
1025  * Result is placed in the indicated location.
1026  */
1027 void
apprvalue(VALUE * v1,VALUE * v2,VALUE * v3,VALUE * vres)1028 apprvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
1029 {
1030 	NUMBER *e;
1031 	long R = 0;
1032 	NUMBER *q1, *q2;
1033 	COMPLEX *c;
1034 
1035 	vres->v_type = v1->v_type;
1036 	vres->v_subtype = V_NOSUBTYPE;
1037 	if (v1->v_type <= 0)
1038 		return;
1039 
1040 	e = NULL;
1041 	switch(v2->v_type) {
1042 	case V_NUM:	e = v2->v_num;
1043 			break;
1044 	case V_NULL:	e = conf->epsilon;
1045 			break;
1046 	default:
1047 		*vres = error_value(E_APPR2);
1048 		return;
1049 	}
1050 	switch(v3->v_type) {
1051 	case V_NUM:	if (qisfrac(v3->v_num)) {
1052 				*vres = error_value(E_APPR3);
1053 				return;
1054 			}
1055 			R = qtoi(v3->v_num);
1056 			break;
1057 	case V_NULL:	R = conf->appr;
1058 			break;
1059 	default:
1060 		*vres = error_value(E_APPR3);
1061 		return;
1062 	}
1063 
1064 	if (qiszero(e)) {
1065 		copyvalue(v1, vres);
1066 		return;
1067 	}
1068 	switch (v1->v_type) {
1069 	case V_NUM:
1070 		vres->v_num = qmappr(v1->v_num, e, R);
1071 		return;
1072 	case V_MAT:
1073 		vres->v_mat = matappr(v1->v_mat, v2, v3);
1074 		return;
1075 	case V_LIST:
1076 		vres->v_list = listappr(v1->v_list, v2, v3);
1077 		return;
1078 	case V_COM:
1079 		q1 = qmappr(v1->v_com->real, e, R);
1080 		q2 = qmappr(v1->v_com->imag, e, R);
1081 		if (qiszero(q2)) {
1082 			vres->v_type = V_NUM;
1083 			vres->v_num = q1;
1084 			qfree(q2);
1085 			return;
1086 		}
1087 		c = comalloc();
1088 		qfree(c->real);
1089 		qfree(c->imag);
1090 		c->real = q1;
1091 		c->imag = q2;
1092 		vres->v_com = c;
1093 		return;
1094 	default:
1095 		*vres = error_value(E_APPR);
1096 		return;
1097 	}
1098 }
1099 
1100 
1101 /*
1102  * Round numbers to number of decimals specified by v2, type of rounding
1103  * specified by v3.  Result placed in location vres.
1104  */
1105 void
roundvalue(VALUE * v1,VALUE * v2,VALUE * v3,VALUE * vres)1106 roundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
1107 {
1108 	NUMBER *q1, *q2;
1109 	COMPLEX *c;
1110 	long places, rnd;
1111 
1112 	vres->v_type = v1->v_type;
1113 	vres->v_subtype = V_NOSUBTYPE;
1114 	if (v1->v_type == V_MAT) {
1115 		vres->v_mat = matround(v1->v_mat, v2, v3);
1116 		return;
1117 	}
1118 	if (v1->v_type == V_LIST) {
1119 		vres->v_list = listround(v1->v_list, v2, v3);
1120 		return;
1121 	}
1122 	if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
1123 		*vres = objcall(OBJ_ROUND, v1, v2, v3);
1124 		return;
1125 	}
1126 	places = 0;
1127 	switch (v2->v_type) {
1128 	case V_NUM:
1129 		if (qisfrac(v2->v_num)) {
1130 			*vres = error_value(E_ROUND2);
1131 			return;
1132 		}
1133 		places = qtoi(v2->v_num);
1134 		break;
1135 	case V_NULL:
1136 		break;
1137 	default:
1138 		*vres = error_value(E_ROUND2);
1139 		return;
1140 	}
1141 	rnd = 0;
1142 	switch (v3->v_type) {
1143 	case V_NUM:
1144 		if (qisfrac(v3->v_num)) {
1145 			*vres = error_value(E_ROUND3);
1146 			return;
1147 		}
1148 		rnd = qtoi(v3->v_num);
1149 		break;
1150 	case V_NULL:
1151 		rnd = conf->round;
1152 		break;
1153 	default:
1154 		*vres = error_value(E_ROUND3);
1155 		return;
1156 	}
1157 	switch(v1->v_type) {
1158 	case V_NUM:
1159 		vres->v_num = qround(v1->v_num, places, rnd);
1160 		return;
1161 	case V_COM:
1162 		q1 = qround(v1->v_com->real, places, rnd);
1163 		q2 = qround(v1->v_com->imag, places, rnd);
1164 		if (qiszero(q2)) {
1165 			vres->v_type = V_NUM;
1166 			vres->v_num = q1;
1167 			qfree(q2);
1168 			return;
1169 		}
1170 		c = comalloc();
1171 		qfree(c->real);
1172 		qfree(c->imag);
1173 		c->real = q1;
1174 		c->imag = q2;
1175 		vres->v_com = c;
1176 		return;
1177 	default:
1178 		if (v1->v_type <= 0)
1179 			return;
1180 		*vres = error_value(E_ROUND);
1181 		return;
1182 	}
1183 }
1184 
1185 
1186 
1187 /*
1188  * Round numbers to number of binary digits specified by v2, type of rounding
1189  * specified by v3.  Result placed in location vres.
1190  */
1191 void
broundvalue(VALUE * v1,VALUE * v2,VALUE * v3,VALUE * vres)1192 broundvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
1193 {
1194 	NUMBER *q1, *q2;
1195 	COMPLEX *c;
1196 	long places, rnd;
1197 
1198 	vres->v_type = v1->v_type;
1199 	vres->v_subtype = V_NOSUBTYPE;
1200 	if (v1->v_type == V_MAT) {
1201 		vres->v_mat = matbround(v1->v_mat, v2, v3);
1202 		return;
1203 	}
1204 	if (v1->v_type == V_LIST) {
1205 		vres->v_list = listbround(v1->v_list, v2, v3);
1206 		return;
1207 	}
1208 	if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
1209 		*vres = objcall(OBJ_BROUND, v1, v2, v3);
1210 		return;
1211 	}
1212 	places = 0;
1213 	switch (v2->v_type) {
1214 	case V_NUM:
1215 		if (qisfrac(v2->v_num)) {
1216 			*vres = error_value(E_BROUND2);
1217 			return;
1218 		}
1219 		places = qtoi(v2->v_num);
1220 		break;
1221 	case V_NULL:
1222 		break;
1223 	default:
1224 		*vres = error_value(E_BROUND2);
1225 		return;
1226 	}
1227 	rnd = 0;
1228 	switch (v3->v_type) {
1229 	case V_NUM:
1230 		if (qisfrac(v3->v_num)) {
1231 			*vres = error_value(E_BROUND3);
1232 			return;
1233 		}
1234 		rnd = qtoi(v3->v_num);
1235 		break;
1236 	case V_NULL:
1237 		rnd = conf->round;
1238 		break;
1239 	default:
1240 		*vres = error_value(E_BROUND3);
1241 		return;
1242 	}
1243 	switch(v1->v_type) {
1244 	case V_NUM:
1245 		vres->v_num = qbround(v1->v_num, places, rnd);
1246 		return;
1247 	case V_COM:
1248 		q1 = qbround(v1->v_com->real, places, rnd);
1249 		q2 = qbround(v1->v_com->imag, places, rnd);
1250 		if (qiszero(q2)) {
1251 			vres->v_type = V_NUM;
1252 			vres->v_num = q1;
1253 			qfree(q2);
1254 			return;
1255 		}
1256 		c = comalloc();
1257 		qfree(c->real);
1258 		qfree(c->imag);
1259 		c->real = q1;
1260 		c->imag = q2;
1261 		vres->v_com = c;
1262 		return;
1263 	default:
1264 		if (v1->v_type <= 0)
1265 			return;
1266 		*vres = error_value(E_BROUND);
1267 		return;
1268 	}
1269 }
1270 
1271 /*
1272  * Take the integer part of an arbitrary value.
1273  * Result is placed in the indicated location.
1274  */
1275 void
intvalue(VALUE * vp,VALUE * vres)1276 intvalue(VALUE *vp, VALUE *vres)
1277 {
1278 	COMPLEX *c;
1279 
1280 	vres->v_type = vp->v_type;
1281 	vres->v_subtype = V_NOSUBTYPE;
1282 	switch (vp->v_type) {
1283 	case V_NUM:
1284 		if (qisint(vp->v_num))
1285 			vres->v_num = qlink(vp->v_num);
1286 		else
1287 			vres->v_num = qint(vp->v_num);
1288 		return;
1289 	case V_COM:
1290 		if (cisint(vp->v_com)) {
1291 			vres->v_com = clink(vp->v_com);
1292 			return;
1293 		}
1294 		vres->v_com = c_int(vp->v_com);
1295 		c = vres->v_com;
1296 		if (cisreal(c)) {
1297 			vres->v_num = qlink(c->real);
1298 			vres->v_type = V_NUM;
1299 			comfree(c);
1300 		}
1301 		return;
1302 	case V_MAT:
1303 		vres->v_mat = matint(vp->v_mat);
1304 		return;
1305 	case V_OBJ:
1306 		*vres = objcall(OBJ_INT, vp, NULL_VALUE, NULL_VALUE);
1307 		return;
1308 	default:
1309 		if (vp->v_type <= 0)
1310 			return;
1311 		*vres = error_value(E_INT);
1312 		return;
1313 	}
1314 }
1315 
1316 
1317 /*
1318  * Take the fractional part of an arbitrary value.
1319  * Result is placed in the indicated location.
1320  */
1321 void
fracvalue(VALUE * vp,VALUE * vres)1322 fracvalue(VALUE *vp, VALUE *vres)
1323 {
1324 	COMPLEX *c;
1325 
1326 	vres->v_type = vp->v_type;
1327 	vres->v_subtype = V_NOSUBTYPE;
1328 	switch (vp->v_type) {
1329 	case V_NUM:
1330 		if (qisint(vp->v_num))
1331 			vres->v_num = qlink(&_qzero_);
1332 		else
1333 			vres->v_num = qfrac(vp->v_num);
1334 		return;
1335 	case V_COM:
1336 		if (cisint(vp->v_com)) {
1337 			vres->v_num = clink(&_qzero_);
1338 			vres->v_type = V_NUM;
1339 			return;
1340 		}
1341 		vres->v_com = c_frac(vp->v_com);
1342 		c = vres->v_com;
1343 		if (cisreal(c)) {
1344 			vres->v_num = qlink(c->real);
1345 			vres->v_type = V_NUM;
1346 			comfree(c);
1347 		}
1348 		return;
1349 	case V_MAT:
1350 		vres->v_mat = matfrac(vp->v_mat);
1351 		return;
1352 	case V_OBJ:
1353 		*vres = objcall(OBJ_FRAC, vp, NULL_VALUE, NULL_VALUE);
1354 		return;
1355 	default:
1356 		if (vp->v_type < 0)
1357 			return;
1358 		*vres = error_value(E_FRAC);
1359 		return;
1360 	}
1361 }
1362 
1363 
1364 /*
1365  * Increment an arbitrary value by one.
1366  * Result is placed in the indicated location.
1367  */
1368 void
incvalue(VALUE * vp,VALUE * vres)1369 incvalue(VALUE *vp, VALUE *vres)
1370 {
1371 	vres->v_type = vp->v_type;
1372 	switch (vp->v_type) {
1373 	case V_NUM:
1374 		vres->v_num = qinc(vp->v_num);
1375 		break;
1376 	case V_COM:
1377 		vres->v_com = c_addq(vp->v_com, &_qone_);
1378 		break;
1379 	case V_OBJ:
1380 		*vres = objcall(OBJ_INC, vp, NULL_VALUE, NULL_VALUE);
1381 		break;
1382 	case V_OCTET:
1383 		*vres->v_octet = *vp->v_octet + 1;
1384 		break;
1385 	case V_OPTR:
1386 		vres->v_octet = vp->v_octet + 1;
1387 		break;
1388 	case V_VPTR:
1389 		vres->v_addr = vp->v_addr + 1;
1390 		break;
1391 	default:
1392 		if (vp->v_type > 0)
1393 			*vres = error_value(E_INCV);
1394 		break;
1395 	}
1396 	vres->v_subtype = vp->v_subtype;
1397 }
1398 
1399 
1400 /*
1401  * Decrement an arbitrary value by one.
1402  * Result is placed in the indicated location.
1403  */
1404 void
decvalue(VALUE * vp,VALUE * vres)1405 decvalue(VALUE *vp, VALUE *vres)
1406 {
1407 	vres->v_type = vp->v_type;
1408 	switch (vp->v_type) {
1409 	case V_NUM:
1410 		vres->v_num = qdec(vp->v_num);
1411 		break;
1412 	case V_COM:
1413 		vres->v_com = c_addq(vp->v_com, &_qnegone_);
1414 		break;
1415 	case V_OBJ:
1416 		*vres = objcall(OBJ_DEC, vp, NULL_VALUE, NULL_VALUE);
1417 		break;
1418 	case V_OCTET:
1419 		*vres->v_octet = *vp->v_octet - 1;
1420 		break;
1421 	case V_OPTR:
1422 		vres->v_octet = vp->v_octet - 1;
1423 		break;
1424 	case V_VPTR:
1425 		vres->v_addr = vp->v_addr - 1;
1426 		break;
1427 	default:
1428 		if (vp->v_type >= 0)
1429 			*vres = error_value(E_DECV);
1430 		break;
1431 	}
1432 	vres->v_subtype = vp->v_subtype;
1433 }
1434 
1435 
1436 /*
1437  * Produce the 'conjugate' of an arbitrary value.
1438  * Result is placed in the indicated location.
1439  * (Example: complex conjugate.)
1440  */
1441 void
conjvalue(VALUE * vp,VALUE * vres)1442 conjvalue(VALUE *vp, VALUE *vres)
1443 {
1444 	vres->v_type = vp->v_type;
1445 	vres->v_subtype = V_NOSUBTYPE;
1446 	switch (vp->v_type) {
1447 	case V_NUM:
1448 		vres->v_num = qlink(vp->v_num);
1449 		return;
1450 	case V_COM:
1451 		vres->v_com = comalloc();
1452 		qfree(vres->v_com->real);
1453 		qfree(vres->v_com->imag)
1454 		vres->v_com->real = qlink(vp->v_com->real);
1455 		vres->v_com->imag = qneg(vp->v_com->imag);
1456 		return;
1457 	case V_MAT:
1458 		vres->v_mat = matconj(vp->v_mat);
1459 		return;
1460 	case V_OBJ:
1461 		*vres = objcall(OBJ_CONJ, vp, NULL_VALUE, NULL_VALUE);
1462 		return;
1463 	default:
1464 		if (vp->v_type <= 0) {
1465 			vres->v_type = vp->v_type;
1466 			return;
1467 		}
1468 		*vres = error_value(E_CONJ);
1469 		return;
1470 	}
1471 }
1472 
1473 
1474 /*
1475  * Take the square root of an arbitrary value within the specified error.
1476  * Result is placed in the indicated location.
1477  */
1478 void
sqrtvalue(VALUE * v1,VALUE * v2,VALUE * v3,VALUE * vres)1479 sqrtvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
1480 {
1481 	NUMBER *q, *tmp;
1482 	COMPLEX *c;
1483 	long R;
1484 
1485 	if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
1486 			*vres = objcall(OBJ_SQRT, v1, v2, v3);
1487 			return;
1488 	}
1489 	vres->v_type = v1->v_type;
1490 	vres->v_subtype = V_NOSUBTYPE;
1491 	if (v1->v_type <= 0) {
1492 		vres->v_type = v1->v_type;
1493 		return;
1494 	}
1495 	if (v2->v_type == V_NULL) {
1496 		q = conf->epsilon;
1497 	} else {
1498 		if (v2->v_type != V_NUM || qiszero(v2->v_num)) {
1499 			*vres = error_value(E_SQRT2);
1500 			return;
1501 		}
1502 		q = v2->v_num;
1503 	}
1504 	if (v3->v_type == V_NULL) {
1505 		R = conf->sqrt;
1506 	} else {
1507 		if (v3->v_type != V_NUM || qisfrac(v3->v_num)) {
1508 			*vres = error_value(E_SQRT3);
1509 			return;
1510 		}
1511 		R = qtoi(v3->v_num);
1512 	}
1513 	switch (v1->v_type) {
1514 	case V_NUM:
1515 		if (!qisneg(v1->v_num)) {
1516 			vres->v_num = qsqrt(v1->v_num, q, R);
1517 			return;
1518 		}
1519 		tmp = qneg(v1->v_num);
1520 		c = comalloc();
1521 		qfree(c->imag);
1522 		c->imag = qsqrt(tmp, q, R);
1523 		qfree(tmp);
1524 		vres->v_com = c;
1525 		vres->v_type = V_COM;
1526 		break;
1527 	case V_COM:
1528 		vres->v_com = c_sqrt(v1->v_com, q, R);
1529 		break;
1530 	default:
1531 		*vres = error_value(E_SQRT);
1532 		return;
1533 	}
1534 	c = vres->v_com;
1535 	if (cisreal(c)) {
1536 		vres->v_num = qlink(c->real);
1537 		vres->v_type = V_NUM;
1538 		comfree(c);
1539 	}
1540 }
1541 
1542 
1543 /*
1544  * Take the Nth root of an arbitrary value within the specified error.
1545  * Result is placed in the indicated location.
1546  *
1547  * given:
1548  *	v1		value to take root of
1549  *	v2		value specifying root to take
1550  *	v3		value specifying error
1551  *	vres		result
1552  */
1553 void
rootvalue(VALUE * v1,VALUE * v2,VALUE * v3,VALUE * vres)1554 rootvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
1555 {
1556 	NUMBER *q2, *q3;
1557 	COMPLEX ctmp;
1558 	COMPLEX *c;
1559 
1560 	vres->v_subtype = V_NOSUBTYPE;
1561 	if (v1->v_type <= 0) {
1562 		vres->v_type = v1->v_type;
1563 		return;
1564 	}
1565 	if (v2->v_type != V_NUM) {
1566 		*vres = error_value(E_ROOT2);
1567 		return;
1568 	}
1569 	q2 = v2->v_num;
1570 	if (qisneg(q2) || qiszero(q2) || qisfrac(q2)) {
1571 		*vres = error_value(E_ROOT2);
1572 		return;
1573 	}
1574 	if (v3->v_type != V_NUM || qiszero(v3->v_num)) {
1575 		*vres = error_value(E_ROOT3);
1576 		return;
1577 	}
1578 	q3 = v3->v_num;
1579 	switch (v1->v_type) {
1580 	case V_NUM:
1581 		if (!qisneg(v1->v_num)) {
1582 			vres->v_num = qroot(v1->v_num, q2, q3);
1583 			if (vres->v_num == NULL)
1584 				*vres = error_value(E_ROOT4);
1585 			vres->v_type = V_NUM;
1586 			return;
1587 		}
1588 		ctmp.real = v1->v_num;
1589 		ctmp.imag = &_qzero_;
1590 		ctmp.links = 1;
1591 		c = c_root(&ctmp, q2, q3);
1592 		break;
1593 	case V_COM:
1594 		c = c_root(v1->v_com, q2, q3);
1595 		break;
1596 	case V_OBJ:
1597 		*vres = objcall(OBJ_ROOT, v1, v2, v3);
1598 		return;
1599 	default:
1600 		*vres = error_value(E_ROOT);
1601 		return;
1602 	}
1603 	if (c == NULL) {
1604 		*vres = error_value(E_ROOT4);
1605 		return;
1606 	}
1607 	vres->v_com = c;
1608 	vres->v_type = V_COM;
1609 	if (cisreal(c)) {
1610 		vres->v_num = qlink(c->real);
1611 		vres->v_type = V_NUM;
1612 		comfree(c);
1613 	}
1614 }
1615 
1616 
1617 /*
1618  * Take the absolute value of an arbitrary value within the specified error.
1619  * Result is placed in the indicated location.
1620  */
1621 void
absvalue(VALUE * v1,VALUE * v2,VALUE * vres)1622 absvalue(VALUE *v1, VALUE *v2, VALUE *vres)
1623 {
1624 	STATIC NUMBER *q;
1625 
1626 	if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
1627 		*vres = objcall(OBJ_ABS, v1, v2, NULL_VALUE);
1628 		return;
1629 	}
1630 	vres->v_subtype = V_NOSUBTYPE;
1631 	if (v1->v_type <= 0) {
1632 		vres->v_type = v1->v_type;
1633 		return;
1634 	}
1635 	switch (v1->v_type) {
1636 	case V_NUM:
1637 		if (qisneg(v1->v_num))
1638 			q = qneg(v1->v_num);
1639 		else
1640 			q = qlink(v1->v_num);
1641 		break;
1642 	case V_COM:
1643 		if (v2->v_type != V_NUM || qiszero(v2->v_num)) {
1644 			*vres = error_value(E_ABS2);
1645 			return;
1646 		}
1647 		q = qhypot(v1->v_com->real, v1->v_com->imag, v2->v_num);
1648 		break;
1649 	default:
1650 		*vres = error_value(E_ABS);
1651 		return;
1652 	}
1653 	vres->v_num = q;
1654 	vres->v_type = V_NUM;
1655 }
1656 
1657 
1658 /*
1659  * Calculate the norm of an arbitrary value.
1660  * Result is placed in the indicated location.
1661  * The norm is the square of the absolute value.
1662  */
1663 void
normvalue(VALUE * vp,VALUE * vres)1664 normvalue(VALUE *vp, VALUE *vres)
1665 {
1666 	NUMBER *q1, *q2;
1667 
1668 	vres->v_type = vp->v_type;
1669 	vres->v_subtype = V_NOSUBTYPE;
1670 	if (vp->v_type <= 0) {
1671 		vres->v_type = vp->v_type;
1672 		return;
1673 	}
1674 	switch (vp->v_type) {
1675 	case V_NUM:
1676 		vres->v_num = qsquare(vp->v_num);
1677 		return;
1678 	case V_COM:
1679 		q1 = qsquare(vp->v_com->real);
1680 		q2 = qsquare(vp->v_com->imag);
1681 		vres->v_num = qqadd(q1, q2);
1682 		vres->v_type = V_NUM;
1683 		qfree(q1);
1684 		qfree(q2);
1685 		return;
1686 	case V_OBJ:
1687 		*vres = objcall(OBJ_NORM, vp, NULL_VALUE, NULL_VALUE);
1688 		return;
1689 	default:
1690 		*vres = error_value(E_NORM);
1691 		return;
1692 	}
1693 }
1694 
1695 
1696 /*
1697  * Shift a value left or right by the specified number of bits.
1698  * Negative shift value means shift the direction opposite the selected dir.
1699  * Right shifts are defined to lose bits off the low end of the number.
1700  * Result is placed in the indicated location.
1701  *
1702  * given:
1703  *	v1		value to shift
1704  *	v2		shift amount
1705  *	rightshift	TRUE if shift right instead of left
1706  *	vres		result
1707  */
1708 void
shiftvalue(VALUE * v1,VALUE * v2,BOOL rightshift,VALUE * vres)1709 shiftvalue(VALUE *v1, VALUE *v2, BOOL rightshift, VALUE *vres)
1710 {
1711 	COMPLEX *c;
1712 	long n = 0;
1713 	unsigned int ch;
1714 	VALUE tmp;
1715 
1716 	vres->v_subtype = V_NOSUBTYPE;
1717 	if (v1->v_type <= 0) {
1718 		vres->v_type = v1->v_type;
1719 		return;
1720 	}
1721 	if ((v2->v_type != V_NUM) || (qisfrac(v2->v_num))) {
1722 		*vres = error_value(E_SHIFT2);
1723 		return;
1724 	}
1725 	if (v1->v_type != V_OBJ) {
1726 		if (zge31b(v2->v_num->num)) {
1727 			*vres = error_value(E_SHIFT2);
1728 			return;
1729 		}
1730 		n = qtoi(v2->v_num);
1731 	}
1732 	if (rightshift)
1733 		n = -n;
1734 	vres->v_type = v1->v_type;
1735 	switch (v1->v_type) {
1736 	case V_NUM:
1737 		if (qisfrac(v1->v_num)) {
1738 			*vres = error_value(E_SHIFT);
1739 			return;
1740 		}
1741 		vres->v_num = qshift(v1->v_num, n);
1742 		return;
1743 	case V_COM:
1744 		if (qisfrac(v1->v_com->real) ||
1745 				qisfrac(v1->v_com->imag)) {
1746 			*vres = error_value(E_SHIFT);
1747 			return;
1748 		}
1749 		c = c_shift(v1->v_com, n);
1750 		if (!cisreal(c)) {
1751 			vres->v_com = c;
1752 			return;
1753 		}
1754 		vres->v_num = qlink(c->real);
1755 		vres->v_type = V_NUM;
1756 		comfree(c);
1757 		return;
1758 	case V_MAT:
1759 		vres->v_mat = matshift(v1->v_mat, n);
1760 		return;
1761 	case V_STR:
1762 		vres->v_str = stringshift(v1->v_str, n);
1763 		if (vres->v_str == NULL)
1764 			*vres = error_value(E_STRSHIFT);
1765 		return;
1766 	case V_OCTET:
1767 		vres->v_type = V_STR;
1768 		if (n >= 8 || n <= -8)
1769 			ch = 0;
1770 		else if (n >= 0)
1771 			ch = (unsigned int) *v1->v_octet << n;
1772 		else
1773 			ch = (unsigned int) *v1->v_octet >> -n;
1774 		vres->v_str = charstring(ch);
1775 		return;
1776 	case V_OBJ:
1777 		if (!rightshift) {
1778 			*vres = objcall(OBJ_SHIFT, v1, v2, NULL_VALUE);
1779 			return;
1780 		}
1781 		tmp.v_num = qneg(v2->v_num);
1782 		tmp.v_type = V_NUM;
1783 		*vres = objcall(OBJ_SHIFT, v1, &tmp, NULL_VALUE);
1784 		qfree(tmp.v_num);
1785 		return;
1786 	default:
1787 		*vres = error_value(E_SHIFT);
1788 		return;
1789 	}
1790 }
1791 
1792 
1793 /*
1794  * Scale a value by a power of two.
1795  * Result is placed in the indicated location.
1796  */
1797 void
scalevalue(VALUE * v1,VALUE * v2,VALUE * vres)1798 scalevalue(VALUE *v1, VALUE *v2, VALUE *vres)
1799 {
1800 	long n = 0;
1801 
1802 	vres->v_subtype = V_NOSUBTYPE;
1803 	if (v1->v_type <= 0) {
1804 		vres->v_type = v1->v_type;
1805 		return;
1806 	}
1807 	if ((v2->v_type != V_NUM) || qisfrac(v2->v_num)) {
1808 		*vres = error_value(E_SCALE2);
1809 		return;
1810 	}
1811 	if (v1->v_type != V_OBJ) {
1812 		if (zge31b(v2->v_num->num)) {
1813 			*vres = error_value(E_SCALE2);
1814 			return;
1815 		}
1816 		n = qtoi(v2->v_num);
1817 	}
1818 	vres->v_type = v1->v_type;
1819 	switch (v1->v_type) {
1820 	case V_NUM:
1821 		vres->v_num = qscale(v1->v_num, n);
1822 		return;
1823 	case V_COM:
1824 		vres->v_com = c_scale(v1->v_com, n);
1825 		return;
1826 	case V_MAT:
1827 		vres->v_mat = matscale(v1->v_mat, n);
1828 		return;
1829 	case V_OBJ:
1830 		*vres = objcall(OBJ_SCALE, v1, v2, NULL_VALUE);
1831 		return;
1832 	default:
1833 		*vres = error_value(E_SCALE);
1834 		return;
1835 	}
1836 }
1837 
1838 
1839 /*
1840  * Raise a value to an power.
1841  * Result is placed in the indicated location.
1842  */
1843 void
powvalue(VALUE * v1,VALUE * v2,VALUE * vres)1844 powvalue(VALUE *v1, VALUE *v2, VALUE *vres)
1845 {
1846 	NUMBER *real_v2;	/* real part of v2 */
1847 	COMPLEX *c;
1848 
1849 	if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
1850 		*vres = objcall(OBJ_POW, v1, v2, NULL_VALUE);
1851 		return;
1852 	}
1853 	vres->v_type = v1->v_type;
1854 	vres->v_subtype = V_NOSUBTYPE;
1855 	if (v1->v_type <= 0 && v1->v_type != -E_1OVER0)
1856 		return;
1857 	if (v2->v_type <= 0) {
1858 		vres->v_type = v2->v_type;
1859 		return;
1860 	}
1861 	real_v2 = v2->v_num;
1862 
1863 	/* case: raising to a real power */
1864 	switch (v2->v_type) {
1865 	case V_NUM:
1866 
1867 		/* deal with the division by 0 value */
1868 		if (v1->v_type == -E_1OVER0) {
1869 			if (qisneg(real_v2)) {
1870 				vres->v_type = V_NUM;
1871 				vres->v_num = qlink(&_qzero_);
1872 			} else {
1873 				vres->v_type = -E_1OVER0;
1874 			}
1875 			break;
1876 		}
1877 
1878 		/* raise something with a real exponent */
1879 		switch (v1->v_type) {
1880 		case V_NUM:
1881 			if (qiszero(v1->v_num)) {
1882 				if (qisneg(real_v2)) {
1883 					*vres = error_value(E_1OVER0);
1884 					break;
1885 				}
1886 				/* 0 ^ non-neg is 1, including 0^0 */
1887 				vres->v_type = V_NUM;
1888 				vres->v_num = qlink(&_qone_);
1889 			} else if (qisint(real_v2)) {
1890 				vres->v_num = qpowi(v1->v_num, real_v2);
1891 			} else {
1892 				vres->v_type = V_NUM;
1893 				vres->v_num = qlink(&_qzero_);
1894 				powervalue(v1, v2, NULL, vres);
1895 			}
1896 			break;
1897 		case V_COM:
1898 			if (qisint(real_v2)) {
1899 				vres->v_com = c_powi(v1->v_com, real_v2);
1900 			} else {
1901 				vres->v_type = V_NUM;
1902 				vres->v_num = qlink(&_qzero_);
1903 				powervalue(v1, v2, NULL, vres);
1904 			}
1905 			if (vres->v_type == V_COM) {
1906 				c = vres->v_com;
1907 				if (!cisreal(c))
1908 					break;
1909 				vres->v_num = qlink(c->real);
1910 				vres->v_type = V_NUM;
1911 				comfree(c);
1912 			}
1913 			break;
1914 		case V_MAT:
1915 			vres->v_mat = matpowi(v1->v_mat, real_v2);
1916 			break;
1917 		default:
1918 			*vres = error_value(E_POWI);
1919 			break;
1920 		}
1921 		break;
1922 
1923 	case V_COM:
1924 
1925 		/* deal with the division by 0 value */
1926 		if (v1->v_type == -E_1OVER0) {
1927 			if (cisreal(v2->v_com) && qisneg(real_v2)) {
1928 				vres->v_type = V_NUM;
1929 				vres->v_num = qlink(&_qzero_);
1930 			} else {
1931 				vres->v_type = -E_1OVER0;
1932 			}
1933 			break;
1934 		}
1935 
1936 		/* raise something with a real exponent */
1937 		switch (v1->v_type) {
1938 		case V_NUM:
1939 			if (qiszero(v1->v_num)) {
1940 				if (cisreal(v2->v_com) && qisneg(real_v2)) {
1941 					*vres = error_value(E_1OVER0);
1942 					break;
1943 				}
1944 				/*
1945 				 * 0 ^ real non-neg is zero
1946 				 * 0 ^ complex is zero
1947 				 */
1948 				vres->v_type = V_NUM;
1949 				vres->v_num = qlink(&_qzero_);
1950 			}
1951 			if (cisreal(v2->v_com) && qisint(real_v2)) {
1952 				vres->v_num = qpowi(v1->v_num, real_v2);
1953 			} else {
1954 				vres->v_type = V_NUM;
1955 				vres->v_num = qlink(&_qzero_);
1956 				powervalue(v1, v2, NULL, vres);
1957 			}
1958 			if (vres->v_type == V_COM) {
1959 				c = vres->v_com;
1960 				if (!cisreal(c))
1961 					break;
1962 				vres->v_num = qlink(c->real);
1963 				vres->v_type = V_NUM;
1964 				comfree(c);
1965 			}
1966 			break;
1967 		case V_COM:
1968 			if (cisreal(v2->v_com) && qisint(real_v2)) {
1969 				vres->v_com = c_powi(v1->v_com, real_v2);
1970 			} else {
1971 				vres->v_type = V_NUM;
1972 				vres->v_num = qlink(&_qzero_);
1973 				powervalue(v1, v2, NULL, vres);
1974 			}
1975 			if (vres->v_type == V_COM) {
1976 				c = vres->v_com;
1977 				if (!cisreal(c))
1978 					break;
1979 				vres->v_num = qlink(c->real);
1980 				vres->v_type = V_NUM;
1981 				comfree(c);
1982 			}
1983 			break;
1984 		default:
1985 			*vres = error_value(E_POWI);
1986 			break;
1987 		}
1988 		break;
1989 
1990 	/* unsupported exponent type */
1991 	default:
1992 		*vres = error_value(E_POWI2);
1993 		break;
1994 	}
1995 	return;
1996 }
1997 
1998 
1999 /*
2000  * Raise one value to another value's power, within the specified error.
2001  * Result is placed in the indicated location.  If v3 is NULL, the
2002  * value conf->epsilon is used.
2003  */
2004 void
powervalue(VALUE * v1,VALUE * v2,VALUE * v3,VALUE * vres)2005 powervalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
2006 {
2007 	NUMBER *epsilon;
2008 	COMPLEX *c, ctmp1, ctmp2;
2009 
2010 	vres->v_subtype = V_NOSUBTYPE;
2011 	if (v1->v_type <= 0) {
2012 		vres->v_type = v1->v_type;
2013 		return;
2014 	}
2015 	if (v1->v_type != V_NUM && v1->v_type != V_COM) {
2016 		*vres = error_value(E_POWER);
2017 		return;
2018 	}
2019 	if (v2->v_type != V_NUM && v2->v_type != V_COM) {
2020 		*vres = error_value(E_POWER2);
2021 		return;
2022 	}
2023 
2024 	/* NULL epsilon means use built-in epsilon value */
2025 	if (v3 == NULL) {
2026 		epsilon = conf->epsilon;
2027 	} else {
2028 		if (v3->v_type != V_NUM || qiszero(v3->v_num)) {
2029 			*vres = error_value(E_POWER3);
2030 			return;
2031 		}
2032 		epsilon = v3->v_num;
2033 	}
2034 	if (qiszero(epsilon)) {
2035 		*vres = error_value(E_POWER3);
2036 		return;
2037 	}
2038 
2039 	switch (TWOVAL(v1->v_type, v2->v_type)) {
2040 	case TWOVAL(V_NUM, V_NUM):
2041 		if (qisneg(v1->v_num)) {
2042 			ctmp1.real = v1->v_num;
2043 			ctmp1.imag = &_qzero_;
2044 			ctmp1.links = 1;
2045 			ctmp2.real = v2->v_num;
2046 			ctmp2.imag = &_qzero_;
2047 			ctmp2.links = 1;
2048 			c = c_power(&ctmp1, &ctmp2, epsilon);
2049 			break;
2050 		}
2051 		vres->v_num = qpower(v1->v_num, v2->v_num, epsilon);
2052 		vres->v_type = V_NUM;
2053 		if (vres->v_num == NULL)
2054 			*vres = error_value(E_POWER4);
2055 		return;
2056 	case TWOVAL(V_NUM, V_COM):
2057 		ctmp1.real = v1->v_num;
2058 		ctmp1.imag = &_qzero_;
2059 		ctmp1.links = 1;
2060 		c = c_power(&ctmp1, v2->v_com, epsilon);
2061 		break;
2062 	case TWOVAL(V_COM, V_NUM):
2063 		ctmp2.real = v2->v_num;
2064 		ctmp2.imag = &_qzero_;
2065 		ctmp2.links = 1;
2066 		c = c_power(v1->v_com, &ctmp2, epsilon);
2067 		break;
2068 	case TWOVAL(V_COM, V_COM):
2069 		c = c_power(v1->v_com, v2->v_com, epsilon);
2070 		break;
2071 	default:
2072 		*vres = error_value(E_POWER);
2073 		return;
2074 	}
2075 	/*
2076 	 * Here for any complex result.
2077 	 */
2078 	vres->v_type = V_COM;
2079 	vres->v_com = c;
2080 	if (cisreal(c)) {
2081 		vres->v_num = qlink(c->real);
2082 		vres->v_type = V_NUM;
2083 		comfree(c);
2084 	}
2085 }
2086 
2087 
2088 /*
2089  * Divide one arbitrary value by another one.
2090  * Result is placed in the indicated location.
2091  */
2092 void
divvalue(VALUE * v1,VALUE * v2,VALUE * vres)2093 divvalue(VALUE *v1, VALUE *v2, VALUE *vres)
2094 {
2095 	COMPLEX *c;
2096 	COMPLEX ctmp;
2097 	NUMBER *q;
2098 	VALUE tmpval;
2099 
2100 	vres->v_type = v1->v_type;
2101 	vres->v_subtype = V_NOSUBTYPE;
2102 	if (v1->v_type <= 0)
2103 		return;
2104 	if (v2->v_type <= 0) {
2105 		if (testvalue(v1) && v2->v_type == -E_1OVER0) {
2106 			vres->v_type = V_NUM;
2107 			vres->v_num = qlink(&_qzero_);
2108 		}
2109 		else
2110 			vres->v_type = v2->v_type;
2111 		return;
2112 	}
2113 	if (!testvalue(v2)) {
2114 		if (testvalue(v1))
2115 			*vres = error_value(E_1OVER0);
2116 		else
2117 			*vres = error_value(E_0OVER0);
2118 		return;
2119 	}
2120 	vres->v_type = v1->v_type;
2121 	switch (TWOVAL(v1->v_type, v2->v_type)) {
2122 	case TWOVAL(V_NUM, V_NUM):
2123 		vres->v_num = qqdiv(v1->v_num, v2->v_num);
2124 		return;
2125 	case TWOVAL(V_COM, V_NUM):
2126 		vres->v_com = c_divq(v1->v_com, v2->v_num);
2127 		return;
2128 	case TWOVAL(V_NUM, V_COM):
2129 		if (qiszero(v1->v_num)) {
2130 			vres->v_num = qlink(&_qzero_);
2131 			return;
2132 		}
2133 		ctmp.real = v1->v_num;
2134 		ctmp.imag = &_qzero_;
2135 		ctmp.links = 1;
2136 		vres->v_com = c_div(&ctmp, v2->v_com);
2137 		vres->v_type = V_COM;
2138 		return;
2139 	case TWOVAL(V_COM, V_COM):
2140 		vres->v_com = c_div(v1->v_com, v2->v_com);
2141 		c = vres->v_com;
2142 		if (cisreal(c)) {
2143 			vres->v_num = qlink(c->real);
2144 			vres->v_type = V_NUM;
2145 			comfree(c);
2146 		}
2147 		return;
2148 	case TWOVAL(V_MAT, V_NUM):
2149 	case TWOVAL(V_MAT, V_COM):
2150 		invertvalue(v2, &tmpval);
2151 		vres->v_mat = matmulval(v1->v_mat, &tmpval);
2152 		freevalue(&tmpval);
2153 		return;
2154 	case TWOVAL(V_STR, V_NUM):
2155 		q = qinv(v2->v_num);
2156 		vres->v_str = stringmul(q, v1->v_str);
2157 		qfree(q);
2158 		if (vres->v_str == NULL)
2159 			*vres = error_value(E_DIV);
2160 		return;
2161 	default:
2162 		if ((v1->v_type != V_OBJ) && (v2->v_type != V_OBJ)) {
2163 			*vres = error_value(E_DIV);
2164 			return;
2165 		}
2166 		*vres = objcall(OBJ_DIV, v1, v2, NULL_VALUE);
2167 		return;
2168 	}
2169 }
2170 
2171 
2172 /*
2173  * Divide one arbitrary value by another one keeping only the integer part.
2174  * Result is placed in the indicated location.
2175  */
2176 void
quovalue(VALUE * v1,VALUE * v2,VALUE * v3,VALUE * vres)2177 quovalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
2178 {
2179 	COMPLEX *c;
2180 	NUMBER *q1, *q2;
2181 	long rnd;
2182 
2183 	vres->v_type = v1->v_type;
2184 	vres->v_subtype = V_NOSUBTYPE;
2185 	if (v1->v_type <= 0)
2186 		return;
2187 
2188 	if (v1->v_type == V_MAT) {
2189 		vres->v_mat = matquoval(v1->v_mat, v2, v3);
2190 		return;
2191 	}
2192 	if (v1->v_type == V_LIST) {
2193 		vres->v_list = listquo(v1->v_list, v2, v3);
2194 		return;
2195 	}
2196 	if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
2197 		*vres = objcall(OBJ_QUO, v1, v2, v3);
2198 		return;
2199 	}
2200 	if (v2->v_type <= 0) {
2201 		vres->v_type = v2->v_type;
2202 		return;
2203 	}
2204 	if (v2->v_type != V_NUM) {
2205 		*vres = error_value(E_QUO2);
2206 		return;
2207 	}
2208 	rnd = 0;
2209 	switch (v3->v_type) {
2210 	case V_NUM:
2211 		if (qisfrac(v3->v_num)) {
2212 			*vres = error_value(E_QUO3);
2213 			return;
2214 		}
2215 		rnd = qtoi(v3->v_num);
2216 		break;
2217 	case V_NULL:
2218 		rnd = conf->quo;
2219 		break;
2220 	default:
2221 		*vres = error_value(E_QUO3);
2222 		return;
2223 	}
2224 	switch (v1->v_type) {
2225 	case V_NUM:
2226 		vres->v_num = qquo(v1->v_num, v2->v_num, rnd);
2227 		return;
2228 	case V_COM:
2229 		q1 = qquo(v1->v_com->real, v2->v_num, rnd);
2230 		q2 = qquo(v1->v_com->imag, v2->v_num, rnd);
2231 		if (qiszero(q2)) {
2232 			qfree(q2);
2233 			vres->v_type = V_NUM;
2234 			vres->v_num = q1;
2235 			return;
2236 		}
2237 		c = comalloc();
2238 		qfree(c->real);
2239 		qfree(c->imag);
2240 		c->real = q1;
2241 		c->imag = q2;
2242 		vres->v_com = c;
2243 		return;
2244 	default:
2245 		*vres = error_value(E_QUO);
2246 		return;
2247 	}
2248 }
2249 
2250 
2251 /*
2252  * Divide one arbitrary value by another one keeping only the remainder.
2253  * Result is placed in the indicated location.
2254  */
2255 void
modvalue(VALUE * v1,VALUE * v2,VALUE * v3,VALUE * vres)2256 modvalue(VALUE *v1, VALUE *v2, VALUE *v3, VALUE *vres)
2257 {
2258 	COMPLEX *c;
2259 	NUMBER *q1, *q2;
2260 	long rnd;
2261 
2262 	vres->v_type = v1->v_type;
2263 	vres->v_subtype = V_NOSUBTYPE;
2264 	if (v1->v_type <= 0)
2265 		return;
2266 
2267 	if (v1->v_type == V_MAT) {
2268 		vres->v_mat = matmodval(v1->v_mat, v2, v3);
2269 		return;
2270 	}
2271 	if (v1->v_type == V_LIST) {
2272 		vres->v_list = listmod(v1->v_list, v2, v3);
2273 		return;
2274 	}
2275 	if (v1->v_type == V_OBJ || v2->v_type == V_OBJ) {
2276 		*vres = objcall(OBJ_MOD, v1, v2, v3);
2277 		return;
2278 	}
2279 	if (v2->v_type <= 0) {
2280 		vres->v_type = v2->v_type;
2281 		return;
2282 	}
2283 	if (v2->v_type != V_NUM) {
2284 		*vres = error_value(E_MOD2);
2285 		return;
2286 	}
2287 	rnd = 0;
2288 	switch (v3->v_type) {
2289 	case V_NUM:
2290 		if (qisfrac(v3->v_num)) {
2291 			*vres = error_value(E_MOD3);
2292 			return;
2293 		}
2294 		rnd = qtoi(v3->v_num);
2295 		break;
2296 	case V_NULL:
2297 		rnd = conf->mod;
2298 		break;
2299 	default:
2300 		*vres = error_value(E_MOD3);
2301 		return;
2302 	}
2303 	switch (v1->v_type) {
2304 	case V_NUM:
2305 		vres->v_num = qmod(v1->v_num, v2->v_num, rnd);
2306 		return;
2307 	case V_COM:
2308 		q1 = qmod(v1->v_com->real, v2->v_num, rnd);
2309 		q2 = qmod(v1->v_com->imag, v2->v_num, rnd);
2310 		if (qiszero(q2)) {
2311 			qfree(q2);
2312 			vres->v_type = V_NUM;
2313 			vres->v_num = q1;
2314 			return;
2315 		}
2316 		c = comalloc();
2317 		qfree(c->real);
2318 		qfree(c->imag);
2319 		c->real = q1;
2320 		c->imag = q2;
2321 		vres->v_com = c;
2322 		return;
2323 	default:
2324 		*vres = error_value(E_MOD);
2325 		return;
2326 	}
2327 }
2328 
2329 
2330 /*
2331  * Test an arbitrary value to see if it is equal to "zero".
2332  * The definition of zero varies depending on the value type.  For example,
2333  * the null string is "zero", and a matrix with zero values is "zero".
2334  * Returns TRUE if value is not equal to zero.
2335  */
2336 BOOL
testvalue(VALUE * vp)2337 testvalue(VALUE *vp)
2338 {
2339 	VALUE val;
2340 	LISTELEM *ep;
2341 	int i;
2342 
2343 	switch (vp->v_type) {
2344 	case V_NUM:
2345 		return !qiszero(vp->v_num);
2346 	case V_COM:
2347 		return !ciszero(vp->v_com);
2348 	case V_STR:
2349 		return stringtest(vp->v_str);
2350 	case V_MAT:
2351 		return mattest(vp->v_mat);
2352 	case V_LIST:
2353 		for (ep = vp->v_list->l_first; ep; ep = ep->e_next) {
2354 			if (testvalue(&ep->e_value))
2355 				return TRUE;
2356 		}
2357 		return FALSE;
2358 	case V_ASSOC:
2359 		return (vp->v_assoc->a_count != 0);
2360 	case V_FILE:
2361 		return validid(vp->v_file);
2362 	case V_NULL:
2363 		break;
2364 	case V_OBJ:
2365 		val = objcall(OBJ_TEST, vp, NULL_VALUE, NULL_VALUE);
2366 		return (val.v_int != 0);
2367 	case V_BLOCK:
2368 		for (i=0; i < vp->v_block->datalen; ++i) {
2369 			if (vp->v_block->data[i]) {
2370 				return TRUE;
2371 			}
2372 		}
2373 		return FALSE;
2374 	case V_OCTET:
2375 		return (*vp->v_octet != 0);
2376 	case V_NBLOCK:
2377 		if (vp->v_nblock->blk->data == NULL)
2378 			return FALSE;
2379 		for (i=0; i < vp->v_nblock->blk->datalen; ++i) {
2380 			if (vp->v_nblock->blk->data[i]) {
2381 				return TRUE;
2382 			}
2383 		}
2384 		return FALSE;
2385 	default:
2386 		return TRUE;
2387 	}
2388 	return FALSE;
2389 }
2390 
2391 
2392 /*
2393  * Compare two values for equality.
2394  * Returns TRUE if the two values differ.
2395  */
2396 BOOL
comparevalue(VALUE * v1,VALUE * v2)2397 comparevalue(VALUE *v1, VALUE *v2)
2398 {
2399 	int r = FALSE;
2400 	VALUE val;
2401 
2402 	if ((v1->v_type == V_OBJ) || (v2->v_type == V_OBJ)) {
2403 		val = objcall(OBJ_CMP, v1, v2, NULL_VALUE);
2404 		return (val.v_int != 0);
2405 	}
2406 	if (v1 == v2)
2407 		return FALSE;
2408 	if (v1->v_type ==  V_OCTET) {
2409 		if (v2->v_type == V_OCTET)
2410 			return (*v1->v_octet != *v2->v_octet);
2411 		if (v2->v_type == V_STR)
2412 			return (*v1->v_octet != (OCTET) *v2->v_str->s_str)
2413 				|| (v2->v_str->s_len != 1);
2414 		if (v2->v_type != V_NUM || qisfrac(v2->v_num) ||
2415 			qisneg(v2->v_num) || v2->v_num->num.len > 1)
2416 				return TRUE;
2417 		return (*v2->v_num->num.v != *v1->v_octet);
2418 	}
2419 	if (v2->v_type == V_OCTET)
2420 		return comparevalue(v2, v1);
2421 	if (v1->v_type != v2->v_type)
2422 		return TRUE;
2423 	if (v1->v_type <= 0)
2424 		return FALSE;
2425 	switch (v1->v_type) {
2426 	case V_NUM:
2427 		r = qcmp(v1->v_num, v2->v_num);
2428 		break;
2429 	case V_COM:
2430 		r = c_cmp(v1->v_com, v2->v_com);
2431 		break;
2432 	case V_STR:
2433 		r = stringcmp(v1->v_str, v2->v_str);
2434 		break;
2435 	case V_MAT:
2436 		r = matcmp(v1->v_mat, v2->v_mat);
2437 		break;
2438 	case V_LIST:
2439 		r = listcmp(v1->v_list, v2->v_list);
2440 		break;
2441 	case V_ASSOC:
2442 		r = assoccmp(v1->v_assoc, v2->v_assoc);
2443 		break;
2444 	case V_FILE:
2445 		r = (v1->v_file != v2->v_file);
2446 		break;
2447 	case V_RAND:
2448 		r = randcmp(v1->v_rand, v2->v_rand);
2449 		break;
2450 	case V_RANDOM:
2451 		r = randomcmp(v1->v_random, v2->v_random);
2452 		break;
2453 	case V_CONFIG:
2454 		r = config_cmp(v1->v_config, v2->v_config);
2455 		break;
2456 	case V_HASH:
2457 		r = hash_cmp(v1->v_hash, v2->v_hash);
2458 		break;
2459 	case V_BLOCK:
2460 		r = blk_cmp(v1->v_block, v2->v_block);
2461 		break;
2462 	case V_OCTET:
2463 		r = (v1->v_octet != v2->v_octet);
2464 		break;
2465 	case V_NBLOCK:
2466 		return (v1->v_nblock != v2->v_nblock);
2467 	case V_VPTR:
2468 		return (v1->v_addr != v2->v_addr);
2469 	case V_OPTR:
2470 		return (v1->v_octet != v2->v_octet);
2471 	case V_SPTR:
2472 		return (v1->v_str != v2->v_str);
2473 	case V_NPTR:
2474 		return (v1->v_num != v2->v_num);
2475 	default:
2476 		math_error("Illegal values for comparevalue");
2477 		/*NOTREACHED*/
2478 	}
2479 	return (r != 0);
2480 }
2481 
2482 BOOL
acceptvalue(VALUE * v1,VALUE * v2)2483 acceptvalue(VALUE *v1, VALUE *v2)
2484 {
2485 	long index;
2486 	FUNC *fp;
2487 	BOOL ret;
2488 
2489 	index = adduserfunc("accept");
2490 	fp = findfunc(index);
2491 	if (fp) {
2492 		++stack;
2493 		stack->v_type = V_ADDR;
2494 		stack->v_subtype = V_NOSUBTYPE;
2495 		stack->v_addr = v1;
2496 		++stack;
2497 		stack->v_type = V_ADDR;
2498 		stack->v_subtype = V_NOSUBTYPE;
2499 		stack->v_addr = v2;
2500 		calculate(fp, 2);
2501 		ret = testvalue(stack);
2502 		freevalue(stack--);
2503 		return ret;
2504 	}
2505 	return (!comparevalue(v1, v2));
2506 }
2507 
2508 
2509 BOOL
precvalue(VALUE * v1,VALUE * v2)2510 precvalue(VALUE *v1, VALUE *v2)
2511 {
2512 	VALUE val;
2513 	long index;
2514 	int r = 0;
2515 	FUNC *fp;
2516 	BOOL ret;
2517 
2518 	index = adduserfunc("precedes");
2519 	fp = findfunc(index);
2520 	if (fp) {
2521 		++stack;
2522 		stack->v_type = V_ADDR;
2523 		stack->v_subtype = V_NOSUBTYPE;
2524 		stack->v_addr = v1;
2525 		++stack;
2526 		stack->v_type = V_ADDR;
2527 		stack->v_subtype = V_NOSUBTYPE;
2528 		stack->v_addr = v2;
2529 		calculate(fp, 2);
2530 		ret = testvalue(stack);
2531 		freevalue(stack--);
2532 		return ret;
2533 	}
2534 	relvalue(v1, v2, &val);
2535 	if ((val.v_type == V_NUM && qisneg(val.v_num)) ||
2536 		(val.v_type == V_COM && qisneg(val.v_com->imag)))
2537 		r = 1;
2538 	if (val.v_type == V_NULL)
2539 		r = (v1->v_type < v2->v_type);
2540 	freevalue(&val);
2541 	return r;
2542 }
2543 
2544 
2545 VALUE
signval(int r)2546 signval(int r)
2547 {
2548 	VALUE val;
2549 
2550 	val.v_type = V_NUM;
2551 	val.v_subtype = V_NOSUBTYPE;
2552 	if (r > 0)
2553 		val.v_num = qlink(&_qone_);
2554 	else if (r < 0)
2555 		val.v_num = qlink(&_qnegone_);
2556 	else
2557 		val.v_num = qlink(&_qzero_);
2558 	return val;
2559 }
2560 
2561 
2562 /*
2563  * Compare two values for their relative values.
2564  * Result is placed in the indicated location.
2565  */
2566 void
relvalue(VALUE * v1,VALUE * v2,VALUE * vres)2567 relvalue(VALUE *v1, VALUE *v2, VALUE *vres)
2568 {
2569 	int r = 0;
2570 	int i = 0;
2571 	NUMBER *q;
2572 	COMPLEX *c;
2573 
2574 	vres->v_subtype = V_NOSUBTYPE;
2575 	vres->v_type = V_NULL;
2576 	if ((v1->v_type == V_OBJ) || (v2->v_type == V_OBJ)) {
2577 		*vres = objcall(OBJ_REL, v1, v2, NULL_VALUE);
2578 		return;
2579 	}
2580 	switch(v1->v_type) {
2581 	case V_NUM:
2582 		switch(v2->v_type) {
2583 		case V_NUM:
2584 			r = qrel(v1->v_num, v2->v_num);
2585 			break;
2586 		case V_OCTET:
2587 			q = itoq((long) *v2->v_octet);
2588 			r = qrel(v1->v_num, q);
2589 			qfree(q);
2590 			break;
2591 		case V_COM:
2592 			r = qrel(v1->v_num, v2->v_com->real);
2593 			i = qrel(&_qzero_, v2->v_com->imag);
2594 			break;
2595 		default:
2596 			return;
2597 		}
2598 		break;
2599 	case V_COM:
2600 		switch(v2->v_type) {
2601 		case V_NUM:
2602 			r = qrel(v1->v_com->real, v2->v_num);
2603 			i = qrel(v1->v_com->imag, &_qzero_);
2604 			break;
2605 		case V_COM:
2606 			r = qrel(v1->v_com->real, v2->v_com->real);
2607 			i = qrel(v1->v_com->imag, v2->v_com->imag);
2608 			break;
2609 		case V_OCTET:
2610 			q = itoq((long) *v2->v_octet);
2611 			r = qrel(v1->v_com->real, q);
2612 			qfree(q);
2613 			i = qrel(v1->v_com->imag, &_qzero_);
2614 			break;
2615 		default:
2616 			return;
2617 		}
2618 		break;
2619 	case V_STR:
2620 		switch(v2->v_type) {
2621 		case V_STR:
2622 			r = stringrel(v1->v_str, v2->v_str);
2623 			break;
2624 		case V_OCTET:
2625 			r = (unsigned char) *v1->v_str->s_str
2626 				- *v2->v_octet;
2627 			if (r == 0) {
2628 				if (v1->v_str->s_len == 0)
2629 					r = -1;
2630 				else
2631 					r = (v1->v_str->s_len > 1);
2632 			}
2633 			break;
2634 		default:
2635 			return;
2636 		}
2637 		break;
2638 	case V_OCTET:
2639 		switch(v2->v_type) {
2640 		case V_NUM:
2641 			q = itoq((long) *v1->v_octet);
2642 			r = qrel(q, v2->v_num);
2643 			qfree(q);
2644 			break;
2645 		case V_COM:
2646 			q = itoq((long) *v1->v_octet);
2647 			r = qrel(q, v2->v_com->real);
2648 			qfree(q);
2649 			i = qrel(&_qzero_, v2->v_com->imag);
2650 			break;
2651 		case V_OCTET:
2652 			r = *v1->v_octet - *v2->v_octet;
2653 			break;
2654 		case V_STR:
2655 			r = *v1->v_octet -
2656 				(unsigned char) *v2->v_str->s_str;
2657 			if (r == 0) {
2658 				if (v2->v_str->s_len == 0)
2659 					r = 1;
2660 				else
2661 					r = -(v2->v_str->s_len > 1);
2662 			}
2663 			break;
2664 		default:
2665 			return;
2666 		}
2667 		break;
2668 	case V_VPTR:
2669 		if (v2->v_type != V_VPTR)
2670 			return;
2671 		r = (v1->v_addr - v2->v_addr);
2672 		break;
2673 	case V_OPTR:
2674 		if (v2->v_type != V_OPTR)
2675 			return;
2676 		r = (v1->v_octet - v2->v_octet);
2677 		break;
2678 	default:
2679 		return;
2680 	}
2681 	vres->v_type = V_NUM;
2682 	*vres = signval(r);
2683 	if (i == 0)
2684 		return;
2685 	c = comalloc();
2686 	qfree(c->real);
2687 	c->real = vres->v_num;
2688 	*vres = signval(i);
2689 	qfree(c->imag);
2690 	c->imag = vres->v_num;
2691 	vres->v_type = V_COM;
2692 	vres->v_com = c;
2693 	return;
2694 }
2695 
2696 
2697 /*
2698  * Find a value representing sign or signs in a value
2699  * Result is placed in the indicated location.
2700  */
2701 void
sgnvalue(VALUE * vp,VALUE * vres)2702 sgnvalue(VALUE *vp, VALUE *vres)
2703 {
2704 	COMPLEX *c;
2705 
2706 	vres->v_type = vp->v_type;
2707 	switch (vp->v_type) {
2708 	case V_NUM:
2709 		vres->v_num = qsign(vp->v_num);
2710 		vres->v_subtype = vp->v_subtype;
2711 		return;
2712 	case V_COM:
2713 		c = comalloc();
2714 		qfree(c->real);
2715 		qfree(c->imag);
2716 		c->real = qsign(vp->v_com->real);
2717 		c->imag = qsign(vp->v_com->imag);
2718 		vres->v_com = c;
2719 		vres->v_type = V_COM;
2720 		vres->v_subtype = V_NOSUBTYPE;
2721 		return;
2722 	case V_OCTET:
2723 		vres->v_type = V_NUM;
2724 		vres->v_subtype = V_NOSUBTYPE;
2725 		vres->v_num = itoq((long) (*vp->v_octet != 0));
2726 		return;
2727 	case V_OBJ:
2728 		*vres = objcall(OBJ_SGN, vp, NULL_VALUE, NULL_VALUE);
2729 		return;
2730 	default:
2731 		if (vp->v_type > 0)
2732 			*vres = error_value(E_SGN);
2733 		return;
2734 	}
2735 }
2736 
2737 
2738 int
userfunc(char * fname,VALUE * vp)2739 userfunc(char *fname, VALUE *vp)
2740 {
2741 	FUNC *fp;
2742 
2743 	fp = findfunc(adduserfunc(fname));
2744 	if (fp == NULL)
2745 		return 0;
2746 	++stack;
2747 	stack->v_addr = vp;
2748 	stack->v_type = V_ADDR;
2749 	stack->v_subtype = V_NOSUBTYPE;
2750 	calculate(fp, 1);
2751 	freevalue(stack--);
2752 	return 1;
2753 }
2754 
2755 
2756 /*
2757  * Print the value of a descriptor in one of several formats.
2758  * If flags contains PRINT_SHORT, then elements of arrays and lists
2759  * will not be printed.	 If flags contains PRINT_UNAMBIG, then quotes
2760  * are placed around strings and the null value is explicitly printed.
2761  */
2762 void
printvalue(VALUE * vp,int flags)2763 printvalue(VALUE *vp, int flags)
2764 {
2765 	NUMBER *qtemp;
2766 	int type;
2767 
2768 	type = vp->v_type;
2769 	if (type < 0) {
2770 		if (userfunc("error_print", vp))
2771 			return;
2772 		if (-type >= E__BASE)
2773 			math_fmt("Error %d", -type);
2774 		else
2775 			math_fmt("System error %d", -type);
2776 		return;
2777 	}
2778 	switch (type) {
2779 	case V_NUM:
2780 		qprintnum(vp->v_num, MODE_DEFAULT, conf->outdigits);
2781 		if (conf->traceflags & TRACE_LINKS)
2782 			math_fmt("#%ld", vp->v_num->links);
2783 		break;
2784 	case V_COM:
2785 		comprint(vp->v_com);
2786 		if (conf->traceflags & TRACE_LINKS)
2787 			math_fmt("##%ld", vp->v_com->links);
2788 		break;
2789 	case V_STR:
2790 		if (flags & PRINT_UNAMBIG)
2791 			math_chr('\"');
2792 		math_str(vp->v_str->s_str);
2793 		if (flags & PRINT_UNAMBIG)
2794 			math_chr('\"');
2795 		break;
2796 	case V_NULL:
2797 		if (flags & PRINT_UNAMBIG)
2798 			math_str("NULL");
2799 		break;
2800 	case V_OBJ:
2801 		(void) objcall(OBJ_PRINT, vp, NULL_VALUE, NULL_VALUE);
2802 		break;
2803 	case V_LIST:
2804 		if (!userfunc("list_print", vp))
2805 			listprint(vp->v_list,
2806 			((flags & PRINT_SHORT) ? 0L : conf->maxprint));
2807 		break;
2808 	case V_ASSOC:
2809 		assocprint(vp->v_assoc,
2810 			((flags & PRINT_SHORT) ? 0L : conf->maxprint));
2811 		break;
2812 	case V_MAT:
2813 		if (!userfunc("mat_print", vp))
2814 			matprint(vp->v_mat,
2815 			((flags & PRINT_SHORT) ? 0L : conf->maxprint));
2816 		break;
2817 	case V_FILE:
2818 		if (!userfunc("file_print", vp))
2819 			printid(vp->v_file, flags);
2820 		break;
2821 	case V_RAND:
2822 		randprint(vp->v_rand, flags);
2823 		break;
2824 	case V_RANDOM:
2825 		randomprint(vp->v_random, flags);
2826 		break;
2827 	case V_CONFIG:
2828 		config_print(vp->v_config);
2829 		break;
2830 	case V_HASH:
2831 		hash_print(vp->v_hash);
2832 		break;
2833 	case V_BLOCK:
2834 		if (!userfunc("blk_print", vp))
2835 			blk_print(vp->v_block);
2836 		break;
2837 	case V_OCTET:
2838 		if (userfunc("octet_print", vp))
2839 			break;
2840 		qtemp = itoq((long) *vp->v_octet);
2841 		qprintnum(qtemp, MODE_DEFAULT, conf->outdigits);
2842 		qfree(qtemp);
2843 		break;
2844 	case V_OPTR:
2845 		math_fmt("o-ptr: %p", (void *)vp->v_octet);
2846 		break;
2847 	case V_VPTR:
2848 		math_fmt("v-ptr: %p", (void *)vp->v_addr);
2849 		break;
2850 	case V_SPTR:
2851 		math_fmt("s_ptr: %p", (void *)vp->v_str);
2852 		break;
2853 	case V_NPTR:
2854 		math_fmt("n_ptr: %p", (void *)vp->v_num);
2855 		break;
2856 	case V_NBLOCK:
2857 		if (!userfunc("nblk_print", vp))
2858 			nblock_print(vp->v_nblock);
2859 		break;
2860 	default:
2861 		math_error("Printing unrecognized type of value");
2862 		/*NOTREACHED*/
2863 	}
2864 }
2865 
2866 /*
2867  * Print an exact text representation of a value
2868  */
2869 void
printestr(VALUE * vp)2870 printestr(VALUE *vp)
2871 {
2872 	LISTELEM *ep;
2873 	MATRIX *mp;
2874 	OBJECT *op;
2875 	BLOCK *bp;
2876 	int mode;
2877 	long i, min, max;
2878 	USB8 *cp;
2879 
2880 	if (vp->v_type < 0) {
2881 		math_fmt("error(%d)", -vp->v_type);
2882 		return;
2883 	}
2884 	switch(vp->v_type) {
2885 		case V_NULL:
2886 			math_str("\"\"");
2887 			return;
2888 		case V_STR:
2889 			math_chr('"');
2890 			strprint(vp->v_str);
2891 			math_chr('"');
2892 			return;
2893 		case V_NUM:
2894 			qprintnum(vp->v_num, MODE_FRAC, conf->outdigits);
2895 			return;
2896 		case V_COM:
2897 			mode = math_setmode(MODE_FRAC);
2898 			comprint(vp->v_com);
2899 			math_setmode(mode);
2900 			return;
2901 		case V_LIST:
2902 			math_str("list(");
2903 			ep = vp->v_list->l_first;
2904 			if (ep) {
2905 				printestr(&ep->e_value);
2906 				while ((ep = ep->e_next)) {
2907 					math_chr(',');
2908 					printestr(&ep->e_value);
2909 				}
2910 			}
2911 			math_chr(')');
2912 			return;
2913 		case V_MAT:
2914 			mp = vp->v_mat;
2915 			if (mp->m_dim == 0)
2916 				math_str("(mat[])");
2917 			else {
2918 				math_str("mat[");
2919 				for (i = 0; i < mp->m_dim; i++) {
2920 					min = mp->m_min[i];
2921 					max = mp->m_max[i];
2922 					if (i > 0)
2923 						math_chr(',');
2924 					if (min)
2925 						math_fmt("%ld:%ld", min, max);
2926 					else
2927 						math_fmt("%ld", max + 1);
2928 				}
2929 				math_chr(']');
2930 			}
2931 			i = mp->m_size;
2932 			vp = mp->m_table;
2933 			break;
2934 		case V_OBJ:
2935 			op = vp->v_obj;
2936 			math_fmt("obj %s",objtypename(op->o_actions->oa_index));
2937 			i = op->o_actions->oa_count;
2938 			vp = op->o_table;
2939 			break;
2940 		case V_BLOCK:
2941 		case V_NBLOCK:
2942 			math_str("blk(");
2943 			if (vp->v_type == V_BLOCK)
2944 				bp = vp->v_block;
2945 			else {
2946 				math_fmt("\"%s\",", vp->v_nblock->name);
2947 				bp = vp->v_nblock->blk;
2948 			}
2949 			i = bp->datalen;
2950 			math_fmt("%ld,%d)", i, (int) bp->blkchunk);
2951 			cp = bp->data;
2952 			if (i > 0) {
2953 				math_str("={");
2954 				math_fmt("%d", *cp);
2955 				while (--i > 0) {
2956 					math_chr(',');
2957 					math_fmt("%d", *++cp);
2958 				}
2959 				math_chr('}');
2960 			}
2961 			return;
2962 
2963 		default:
2964 			math_str("\"???\"");
2965 			return;
2966 	}
2967 	if (i > 0) {
2968 		math_str("={");
2969 		printestr(vp);
2970 		while (--i > 0) {
2971 			math_chr(',');
2972 			printestr(++vp);
2973 		}
2974 		math_chr('}');
2975 	}
2976 }
2977 
2978 
2979 /*
2980  * config_print - print a configuration value
2981  *
2982  * given:
2983  *	cfg		what to print
2984  */
2985 void
config_print(CONFIG * cfg)2986 config_print(CONFIG *cfg)
2987 {
2988 	NAMETYPE *cp;
2989 	VALUE tmp;
2990 	int tab_over;		/* TRUE => OK move over one tab stop */
2991 	size_t len;
2992 
2993 	/*
2994 	 * firewall
2995 	 */
2996 	if (cfg == NULL || cfg->epsilon == NULL || cfg->prompt1 == NULL ||
2997 	    cfg->prompt2 == NULL) {
2998 		math_error("CONFIG value is invalid");
2999 		/*NOTREACHED*/
3000 	}
3001 
3002 	/*
3003 	 * print each element
3004 	 */
3005 	tab_over = FALSE;
3006 	for (cp = configs; cp->name; cp++) {
3007 
3008 		/* skip if special all or duplicate maxerr value */
3009 		if (cp->type == CONFIG_ALL || strcmp(cp->name, "maxerr") == 0 ||
3010 		    strcmp(cp->name, "ctrl-d") == 0)
3011 			continue;
3012 
3013 		/* print tab if allowed */
3014 		if (tab_over) {
3015 			math_str("\t");
3016 		} else if (conf->tab_ok) {
3017 			tab_over = TRUE;	/* tab next time */
3018 		}
3019 
3020 		/* print name and spaces */
3021 		math_fmt("%s", cp->name);
3022 		len = 16 - strlen(cp->name);
3023 		while (len-- > 0)
3024 			math_str(" ");
3025 
3026 		/* print value */
3027 		config_value(cfg, cp->type, &tmp);
3028 		printvalue(&tmp, PRINT_SHORT | PRINT_UNAMBIG);
3029 		freevalue(&tmp);
3030 		if ((cp+1)->name)
3031 			math_str("\n");
3032 	}
3033 }
3034