1: /*
2: * $Id: operator.c,v 1.9 2025/05/05 22:52:32 snw Exp $
3: * operators pattern-match, divide, multiply, add, power
4: *
5: *
6: * Author: Serena Willis <snw@coherent-logic.com>
7: * Copyright (C) 1998 MUG Deutschland
8: * Copyright (C) 2020, 2025 Coherent Logic Development LLC
9: *
10: *
11: * This file is part of FreeM.
12: *
13: * FreeM is free software: you can redistribute it and/or modify
14: * it under the terms of the GNU Affero Public License as published by
15: * the Free Software Foundation, either version 3 of the License, or
16: * (at your option) any later version.
17: *
18: * FreeM is distributed in the hope that it will be useful,
19: * but WITHOUT ANY WARRANTY; without even the implied warranty of
20: * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21: * GNU Affero Public License for more details.
22: *
23: * You should have received a copy of the GNU Affero Public License
24: * along with FreeM. If not, see <https://www.gnu.org/licenses/>.
25: *
26: * $Log: operator.c,v $
27: * Revision 1.9 2025/05/05 22:52:32 snw
28: * Make E notation error message more appropriate
29: *
30: * Revision 1.8 2025/05/05 19:34:46 snw
31: * Fix E notation code to disallow more than one minus sign after the E
32: *
33: * Revision 1.7 2025/04/10 01:24:38 snw
34: * Remove C++ style comments
35: *
36: * Revision 1.6 2025/04/09 19:52:02 snw
37: * Eliminate as many warnings as possible while building with -Wall
38: *
39: * Revision 1.5 2025/03/09 19:50:47 snw
40: * Second phase of REUSE compliance and header reformat
41: *
42: *
43: * SPDX-FileCopyrightText: (C) 2025 Coherent Logic Development LLC
44: * SPDX-License-Identifier: AGPL-3.0-or-later
45: **/
46:
47: #include "mpsdef.h"
48: #include <stdlib.h>
49: #include <math.h>
50:
51: int unit (char *str);
52: extern void cond_round (char *a, int digits); /* defined in expr.c */
53:
54:
55:
56: #define PLUS '+'
57: #define MINUS '-'
58: #define POINT '.'
59: #define point (POINT-ZERO)
60: #define ZERO '0'
61: #define ONE (ZERO+1)
62: #define TWO (ZERO+2)
63: #define THREE (ZERO+3)
64: #define FIVE (ZERO+(NUMBASE/2))
65: #define NINE (ZERO+NUMBASE-1)
66: #define NUMBASE 10
67:
68: short int
69: pattern (char *a, char *b) /* evaluates a ? b */
70: {
71: short levels; /* depth of stack */
72: register int patx; /* match stack pointer */
73: short notpatclass; /* pattern class negation */
74: char *ptrpcd[PATDEPTH], /* pointers to patcode */
75: *position[PATDEPTH]; /* position of matching substring */
76: short mincnt[PATDEPTH], /* minimum number of matches */
77: maxcnt[PATDEPTH], /* maximum number of matches */
78: actcnt[PATDEPTH]; /* actual count of matches */
79: short Pflag,
80: Pchar; /* status in pattern alternation */
81: short altc; /* alternation counter */
82: short altcnt[PATDEPTH]; /* gr.pat.alternation counters */
83:
84: unsigned char gpmin[PATDEPTH][PATDEPTH][255]; /* grouped pattern minimum lengthes */
85: char *gp_position[PATDEPTH][PATDEPTH]; /* grouped patt.pos.of substr */
86:
87: char *ptrtom; /* pointer to match code */
88: char patcode;
89: int ch;
90: int i;
91:
92: pattrnflag = Pflag = FALSE; /* incomplete match flag */
93: pattrnchar = Pchar = EOL; /* incomplete match supplement */
94: notpatclass = FALSE; /* pattern class negation */
95: patx = 0;
96: while (*b != EOL) { /* get minimum repeat count */
97: mincnt[patx] = 0;
98: maxcnt[patx] = 255;
99: altcnt[patx] = (-1);
100: if (*b != '.') {
101: ch = (*b++) - '0';
102: while (*b >= '0' && *b <= '9') {
103: ch *= 10;
104: ch += (*b++) - '0';
105: }
106: mincnt[patx] = ch;
107: if (*b != '.')
108: maxcnt[patx] = ch;
109: }
110: /* get maximum repeat count */
111: if (*b == '.') {
112: b++;
113: if (*b >= '0' && *b <= '9') {
114: ch = (*b++) - '0';
115: while (*b >= '0' && *b <= '9') {
116: ch *= 10;
117: ch += (*b++) - '0';
118: }
119: maxcnt[patx] = ch;
120: }
121: }
122: if (maxcnt[patx] < mincnt[patx])
123: return '2'; /* just impossible! */
124: ptrpcd[patx] = b;
125: actcnt[patx] = 0;
126: position[patx] = 0;
127: /* scan strlit, ignore it when empty */
128: if (*b == '"' || *b == 'z' || (*b == '\'' && *(b + 1) == '"')) {
129: if (*(++b) == DELIM) {
130: b++;
131: continue;
132: }
133: while (*(++b) != DELIM) ;
134: b++;
135: } else if (*b == '(') {
136: i = 1;
137: b++;
138: while ((ch = *b) != EOL) {
139: b++;
140: if (ch == '"') {
141: while (*(++b) != DELIM) ;
142: }
143: if (ch == '(') {
144: i++;
145: continue;
146: }
147: if (ch == ')') {
148: i--;
149: if (i < 1)
150: break;
151: }
152: }
153: } else
154: while (*(++b) >= 'A') ;
155: if (++patx >= (PATDEPTH - 1))
156: return '3'; /* stack overflow */
157: }
158: levels = patx;
159: if (*(b - 1) == 'e' && mincnt[levels - 1] == 0 && maxcnt[levels - 1] == 255)
160: *(b - 1) = '~'; /* frequent special case: last pattern is '.E' */
161: mincnt[levels] = maxcnt[levels] = 1; /* sentinel, does never match */
162: actcnt[levels] = 0;
163: ptrpcd[levels] = b; /* (*b==EOL) */
164: patx = 0;
165: while (patx <= levels) {
166: while (actcnt[patx] < mincnt[patx]) {
167: actcnt[patx]++;
168: if (*a == EOL) {
169: pattrnflag = TRUE; /* incomplete match flag */
170: if (patx >= levels) {
171: pattrnchar = EOL;
172: return '1';
173: }
174: if (patx > 0) {
175: if (actcnt[patx - 1] != maxcnt[patx - 1])
176: return '0';
177: /* after alternation we are not sure about */
178: /* that supplement character */
179: if (*(ptrpcd[patx - 1]) == '(') {
180: pattrnchar = EOL;
181: return '0';
182: }
183: }
184: if (*(ptrpcd[patx]) == '"')
185: pattrnchar = *(ptrpcd[patx] + 1);
186: return '0';
187: }
188: for (;;)
189: {
190: /***begin section: does that char match current pattern code ***/
191: ptrtom = ptrpcd[patx];
192: ch = (*a);
193: for (;;)
194: {
195: patcode = (*ptrtom++);
196: if ((notpatclass = (patcode == '\'')))
197: patcode = (*ptrtom++);
198: switch (patcode) { /* we live in an ASCII/ISO world !! */
199: case 'c':
200: if (((ch < SP && ch >= NUL)
201: || ch == DEL) != notpatclass)
202: goto match;
203: break;
204: case 'n':
205: if ((ch <= '9' && ch >= '0') != notpatclass)
206: goto match;
207: break;
208: case 'p':
209: if (((ch >= SP && ch <= '/') ||
210: (ch >= ':' && ch <= '@') ||
211: (ch >= '[' && ch <= '`') ||
212: (ch >= '{' && ch <= '~') ||
213: (ch == '\200')) != notpatclass)
214: goto match;
215: break;
216: case 'a':
217: if (((ch >= 'A' && ch <= 'Z') ||
218: (ch >= 'a' && ch <= 'z')) != notpatclass)
219: goto match;
220: break;
221: case 'l':
222: if ((ch >= 'a' && ch <= 'z') != notpatclass)
223: goto match;
224: break;
225: case 'u':
226: if ((ch >= 'A' && ch <= 'Z') != notpatclass)
227: goto match;
228: break;
229: case 'e':
230: if (!notpatclass)
231: goto match;
232: break;
233: case '"':
234: i = 0;
235: while (a[i++] == (*ptrtom++)) ;
236: if ((*--ptrtom) == DELIM) {
237: if (notpatclass)
238: goto nomatch;
239: b = ptrpcd[patx] + 1;
240: while (*b++ != DELIM)
241: a++;
242: goto match0;
243: }
244: if (notpatclass) {
245: i--;
246: while (*ptrtom++ != DELIM) {
247: if (a[i++] == EOL)
248: goto nomatch;
249: }
250: b = ptrpcd[patx] + 2;
251: while (*b++ != DELIM)
252: a++;
253: goto match0;
254: }
255: if (a[i - 1] == EOL) {
256: pattrnflag = TRUE;
257: pattrnchar = *ptrtom;
258: }
259: goto nomatch;
260:
261: case '~':{
262: pattrnchar = EOL; /* '.E' as last pat_atom */
263: pattrnflag = TRUE;
264: return '1';
265: }
266: /* grouped pattern match */
267: case '(':{
268: char aa[256];
269: char bb[256];
270: int i1,
271: min,
272: max;
273: short pflag;
274: short pchar;
275:
276: if (Pflag) {
277: pflag = Pflag;
278: pchar = Pchar;
279: } else {
280: pflag = FALSE;
281: pchar = EOL;
282: }
283: if (altcnt[patx] < 0) {
284: for (altc = 0; altc < PATDEPTH; altc++)
285: gpmin[patx][altc][1] = 0;
286: }
287: altcnt[patx] = 0;
288: alternation:;
289: i = 0;
290: i1 = 1;
291: while (i1) {
292: bb[i] = *ptrtom++;
293: if (bb[i] == '"') {
294: while ((bb[++i] = (*ptrtom++)) != DELIM) ;
295: }
296: if (bb[i] == '(')
297: i1++;
298: if (bb[i] == ')')
299: i1--;
300: if (bb[i] == ',' && i1 == 1)
301: i1--;
302: i++;
303: }
304: bb[--i] = EOL;
305: pminmax (bb, &min, &max);
306:
307: if ((i1 = gpmin[patx][altcnt[patx]][actcnt[patx]]) < min)
308: gpmin[patx][altcnt[patx]][actcnt[patx]] = i1 = min;
309: gpmin[patx][altcnt[patx]][actcnt[patx] + 1] = 0;
310: /* too much charaters to get a match! */
311: if (i1 > max) {
312: if (*(ptrtom - 1) == ',') {
313: altcnt[patx]++;
314: goto alternation;
315: }
316: pattrnflag = pflag;
317: pattrnchar = pchar;
318: goto nomatch;
319: }
320: /* if number of chars too small, try anyway */
321: /* to get info for "incomplete" match */
322: for (i = 0; i < i1; i++)
323: if ((aa[i] = a[i]) == EOL)
324: break;
325: gp_position[patx][actcnt[patx]] = a;
326:
327: for (;;)
328: {
329: aa[i] = EOL;
330: i1 = pattern (aa, bb);
331: if (i1 == '1') {
332: gpmin[patx][altcnt[patx]][actcnt[patx]] = i;
333: a += i;
334: goto match0;
335: }
336: if (i1 != '0')
337: return i1;
338: if (pattrnflag) {
339: if (pflag == FALSE)
340: pchar = pattrnchar;
341: else if (pchar != pattrnchar)
342: pchar = EOL;
343: pflag = TRUE;
344: }
345: if (!pattrnflag) {
346: if (*(ptrtom - 1) == ',') {
347: altcnt[patx]++;
348: goto alternation;
349: }
350: pattrnflag = pflag;
351: pattrnchar = pchar;
352: goto nomatch;
353: }
354: if (a[i] == EOL) {
355: Pflag = pflag;
356: Pchar = pchar;
357: if (*(ptrtom - 1) == ',') {
358: altcnt[patx]++;
359: goto alternation;
360: }
361: pattrnflag = pflag;
362: pattrnchar = pchar;
363: return '0';
364: }
365: aa[i] = a[i];
366: i++;
367: }
368: }
369: /* match one of listed characters ?1Z"string" */
370: case 'z':
371: for (;;)
372: {
373: if ((*++ptrtom) == DELIM) {
374: if (notpatclass)
375: goto match;
376: goto nomatch;
377: }
378: if (ch != *ptrtom) {
379: if (*(ptrtom + 1) == '.' && *(ptrtom + 2) == '.') {
380: if (ch < *ptrtom ||
381: (ch > *(ptrtom + 3) && *(ptrtom + 3) != DELIM)) {
382: ptrtom += 2;
383: continue;
384: }
385: } else
386: continue;
387: }
388: while (*++ptrtom != DELIM) ;
389: if (notpatclass)
390: goto nomatch;
391: goto match;
392: }
393:
394: /* loadable matches */
395: case 'C':
396: i = 0;
397: while (zmc[i] != EOL) {
398: if (zmc[i] == ch && !notpatclass)
399: goto match;
400: i++;
401: }
402: if (notpatclass)
403: goto match;
404: break;
405: case 'N':
406: i = 0;
407: while (zmn[i] != EOL) {
408: if (zmn[i] == ch && !notpatclass)
409: goto match;
410: i++;
411: }
412: if (notpatclass)
413: goto match;
414: break;
415: case 'P':
416: i = 0;
417: while (zmp[i] != EOL) {
418: if (zmp[i] == ch && !notpatclass)
419: goto match;
420: i++;
421: }
422: if (notpatclass)
423: goto match;
424: break;
425: case 'A':
426: i = 0;
427: while (zmu[i] != EOL) {
428: if (zmu[i] == ch && !notpatclass)
429: goto match;
430: i++;
431: }
432: case 'L':
433: i = 0;
434: while (zml[i] != EOL) {
435: if (zml[i] == ch && !notpatclass)
436: goto match;
437: i++;
438: }
439: if (notpatclass)
440: goto match;
441: break;
442: case 'U':
443: i = 0;
444: while (zmu[i] != EOL) {
445: if (zmu[i] == ch && !notpatclass)
446: goto match;
447: i++;
448: }
449: if (notpatclass)
450: goto match;
451: break;
452: default:
453: goto nomatch;
454: } /* end_switch */
455: } /* end repeat */
456: /*** end section: does that char match current pattern atom ***/
457: nomatch:;
458: if (patcode == '(') {
459: for (altc = 0; altc <= altcnt[patx]; altc++)
460: gpmin[patx][altc][actcnt[patx]] = 0;
461: if (--actcnt[patx] > 0) {
462: for (altc = 0; altc <= altcnt[patx]; altc++)
463: gpmin[patx][altc][actcnt[patx]]++;
464: a = gp_position[patx][actcnt[patx]]; /* try previous patterns again */
465: continue;
466: }
467: }
468: do {
469: actcnt[patx] = 0;
470: if (--patx < 0)
471: return '0'; /* stack exhausted */
472: if (*(ptrpcd[patx]) == '(') {
473: if (actcnt[patx] >= maxcnt[patx]) {
474: ++actcnt[patx];
475: patcode = '(';
476: goto nomatch;
477: }
478: }
479: } while (++actcnt[patx] > maxcnt[patx]);
480: a = position[patx]; /* try previous patterns again */
481:
482: } /* end repeat */
483: match:;
484: a++;
485: match0:;
486: }
487: position[patx++] = a; /* pos after last match */
488: }
489: return '0';
490: } /* end of pattern */
491:
492: /******************************************************************************/
493: void pminmax (char *str, int *min, int *max)
494: {
495: int mininc,
496: maxinc,
497: i,
498: ch;
499:
500: *min = 0;
501: *max = 0;
502: mininc = 0;
503: maxinc = 0;
504: i = 0;
505: ch = 0;
506: while (str[i] != EOL) {
507: if (str[i] != '.') { /* scan minimum repeat count */
508: ch = (str[i++]) - '0';
509: while (str[i] >= '0' && str[i] <= '9') {
510: ch *= 10;
511: ch += (str[i++]) - '0';
512: }
513: mininc = ch;
514: maxinc = ch;
515: } else {
516: mininc = 0;
517: maxinc = 255;
518: }
519: if (str[i] == '.') { /* scan maximum repeat count */
520: i++;
521: if (str[i] >= '0' && str[i] <= '9') {
522: ch = (str[i++]) - '0';
523: while (str[i] >= '0' && str[i] <= '9') {
524: ch *= 10;
525: ch += (str[i]++) - '0';
526: }
527: } else
528: ch = 255;
529: maxinc = ch;
530: }
531: /* skip pattern codes */
532: if (str[i] == '"') {
533: int cnt;
534:
535: cnt = 0;
536: while (str[++i] != DELIM)
537: cnt++;
538: mininc = mininc * cnt;
539: maxinc = maxinc * cnt;
540: }
541: if (str[i] == 'z' || str[i] == '"') {
542: while (str[++i] != DELIM) ;
543: i++;
544: } else if (str[i] == '(') {
545: char tmp[256];
546: char *tcur;
547: int tmin,
548: tmax,
549: Tmin,
550: Tmax,
551: i1;
552:
553: tmin = 255;
554: tmax = 0;
555: alternation:;
556: i1 = 1;
557: tcur = tmp;
558: while (i1) {
559: ch = str[++i];
560: *tcur++ = ch;
561: if (ch == '"')
562: while ((*tcur++ = str[++i]) != DELIM) ;
563: if (ch == '(')
564: i1++;
565: if (ch == ')')
566: i1--;
567: if (ch == ',' && i1 == 1)
568: i1--;
569: }
570: *(--tcur) = EOL;
571: pminmax (tmp, &Tmin, &Tmax);
572: if (Tmin < tmin)
573: tmin = Tmin;
574: if (Tmax > tmax)
575: tmax = Tmax;
576: if (str[i] == ',')
577: goto alternation;
578: i++;
579: mininc *= tmin;
580: maxinc *= tmax;
581: } else
582: while (str[++i] >= 'A') ;
583: *min += mininc;
584: *max += maxinc;
585: }
586: if (*max > 255)
587: *max = 255;
588: return;
589: } /* end pminmax() */
590: /******************************************************************************/
591: void add (char *a, char *b) /* string arithmetic a+=b; */
592: {
593:
594: if (b[0] == ZERO)
595: return;
596: if (a[0] == ZERO) {
597: stcpy (a, b);
598: return;
599: } {
600: long dpa, /* decimal point of 'a' */
601: dpb, /* decimal point of 'b' */
602: lena, /* length of 'a' */
603: lenb; /* length of 'b' */
604: char mi; /* minus flag */
605: short sign; /* sign flag if a<0<b sign=-1; */
606:
607: /* if a>0>b sign=1; */
608: /* else sign=0; */
609:
610: register int i;
611: register int ch;
612: register int j;
613: register int carry;
614:
615: #if !defined(_AIX)
616: if (fp_mode) {
617: double fp_a;
618: double fp_b;
619:
620: stcnv_m2c (a);
621: stcnv_m2c (b);
622:
623: fp_a = atof (a);
624: fp_b = atof (b);
625:
626: snprintf (a, STRLEN - 1, fp_conversion, fp_a + fp_b);
627: trim_decimal (a);
628:
629: return;
630: }
631: #endif
632:
633:
634:
635: /* look at the signs */
636: mi = 0;
637: sign = 0;
638: if (a[0] == b[0] && a[0] == MINUS) {
639: mi++;
640: a[0] = b[0] = ZERO;
641: } else if (a[0] == MINUS) {
642: sign--;
643: a[0] = NINE;
644: i = 0;
645: while ((ch = a[++i]) != EOL)
646: if (ch != POINT)
647: a[i] = ZERO + NINE - ch;
648: a[--i]++;
649: } else if (b[0] == MINUS) {
650: sign++;
651: b[0] = NINE;
652: i = 0;
653: while ((ch = b[++i]) != EOL)
654: if (ch != POINT)
655: b[i] = ZERO + NINE - ch;
656: b[--i]++;
657: }
658: /* search decimal points and length */
659: dpa = dpb = (-1);
660: i = 0;
661: while (a[i] != EOL) {
662: if (a[i] == POINT)
663: dpa = i;
664: i++;
665: }
666: lena = i;
667: if (dpa < 0)
668: dpa = i;
669: again:;
670: i = 0;
671: while (b[i] != EOL) {
672: if (b[i] == POINT)
673: dpb = i;
674: i++;
675: }
676: lenb = i;
677: if (dpb < 0)
678: dpb = i;
679: if (i == 1) {
680: if (b[0] == ONE && sign == 0 && dpa > 0) { /* frequent special case: add 1 */
681: i = dpa - 1;
682: while (++a[i] > NINE) {
683: a[i--] = ZERO;
684: if (i < 0) {
685: i = lena;
686: while (i >= 0) {
687: a[i + 1] = a[i];
688: i--;
689: }
690: a[0] = ONE;
691: return;
692: }
693: }
694: return;
695: }
696: }
697: /* copy additional trailing digits from b to a */
698: if (lenb - dpb > lena - dpa) {
699: j = dpa - dpb;
700: if (lenb + j > STRLEN) { /* round off that monster ! */
701: i = STRLEN - j;
702: if (b[i] < FIVE) {
703: b[i] = EOL;
704: lenb--;
705: while (b[--i] == ZERO) {
706: b[i] = EOL;
707: lenb--;
708: }
709: } else {
710: for (;;)
711: {
712: if (i >= dpb) {
713: b[i] = EOL;
714: lenb--;
715: } else
716: b[i] = ZERO;
717: if (--i < 0) {
718: for (i = lenb; i >= 0; i--)
719: b[i + 1] = b[i];
720: b[0] = ONE;
721: dpb = ++lenb;
722: break;
723: }
724: if ((ch = b[i]) == POINT) {
725: dpb = i;
726: continue;
727: }
728: if (ch < NINE && ch >= ZERO) {
729: b[i] = ++ch;
730: break;
731: }
732: }
733: }
734: goto again; /* look what's left from b */
735: }
736: lenb = i = lena - dpa + dpb;
737: j = lena;
738: while ((a[j++] = b[i++]) != EOL) ;
739: lena = (--j);
740: b[lenb] = EOL;
741: }
742: /* $justify a or b */
743: i = dpa - dpb;
744: if (i < 0) {
745: j = lena;
746: if ((i = (lena -= i)) > (STRLEN - 2) /*was 253*/) {
747: merr_raise (M75);
748: return;
749: }
750: ch = (sign >= 0 ? ZERO : NINE);
751: while (j >= 0)
752: a[i--] = a[j--];
753: while (i >= 0)
754: a[i--] = ch;
755: dpa = dpb;
756: } else if (i > 0) {
757: j = lenb;
758: if ((lenb = (i += lenb)) > (STRLEN - 2)/*was 253*/) {
759: merr_raise (M75);
760: return;
761: }
762: ch = (sign <= 0 ? ZERO : NINE);
763: while (j >= 0)
764: b[i--] = b[j--];
765: while (i >= 0)
766: b[i--] = ch;
767: dpb = dpa;
768: }
769: /* now add */
770: carry = 0;
771: for (i = lenb - 1; i >= 0; i--) {
772: if ((ch = a[i]) == POINT)
773: continue;
774: ch += b[i] - ZERO + carry;
775: if ((carry = (ch > NINE)))
776: ch -= NUMBASE;
777: a[i] = ch;
778: }
779: while (a[lena] != EOL)
780: lena++;
781: if (carry) {
782: if ((i = (++lena)) > (STRLEN - 2)/*was 253*/) {
783: merr_raise (M75);
784: return;
785: }
786: while (i > 0) {
787: a[i] = a[i - 1];
788: i--;
789: }
790: a[0] = ONE;
791: }
792: if (sign) {
793: if (a[0] == ONE) {
794: a[0] = ZERO;
795: } else {
796: i = 0;
797: carry = 0;
798: while ((ch = a[++i]) != EOL)
799: if (ch != POINT)
800: a[i] = ZERO + NINE - ch;
801: while (--i > 0) {
802: if (a[i] != POINT) {
803: if (++a[i] <= NINE)
804: break;
805: a[i] = ZERO;
806: }
807: }
808: mi = 1;
809: a[0] = ZERO;
810: }
811: while (a[(int) mi] == ZERO) {
812: stcpy (&a[(int) mi], &a[((int) mi) + 1]);
813: dpa--;
814: }
815: if (dpa < 0)
816: dpa = 0;
817: }
818: /* remove trailing zeroes */
819: i = dpa;
820: while (a[i] != EOL)
821: i++;
822: if (--i > dpa) {
823: while (a[i] == ZERO)
824: a[i--] = EOL;
825: }
826: /* remove trailing point */
827: if (a[i] == POINT)
828: a[i] = EOL;
829: if (mi) {
830: if (a[0] != ZERO) {
831: i = 0;
832: while (a[i++] != EOL) ;
833: while (i > 0) {
834: a[i] = a[i - 1];
835: i--;
836: }
837: }
838: a[0] = MINUS;
839: }
840: if (a[(int) mi] == EOL) {
841: a[0] = ZERO;
842: a[1] = EOL;
843: }
844: return;
845: }
846: }
847: /******************************************************************************/
848: void mul (char *a, char *b) /* string arithmetic a=a*b */
849: {
850: char c[2*(STRLEN+1) /*was 512*/];
851: short alen,
852: blen,
853: clen,
854: mi,
855: tmpx;
856: register int acur;
857: register int bcur;
858: register int ccur;
859: register int carry;
860:
861: #if !defined(_AIX)
862: if (fp_mode) {
863: double fp_a;
864: double fp_b;
865:
866: stcnv_m2c (a);
867: stcnv_m2c (b);
868:
869: fp_a = atof (a);
870: fp_b = atof (b);
871:
872: snprintf (a, STRLEN - 1, fp_conversion, fp_a * fp_b);
873: trim_decimal (a);
874:
875: return;
876: }
877: #endif
878:
879:
880: if (merr () > OK)
881: return; /* avoid nonsense in recursion */
882: /* if zero or one there's not much to do */
883: if (b[1] == EOL) {
884: if (b[0] == ZERO) {
885: a[0] = ZERO;
886: a[1] = EOL;
887: return;
888: }
889: if (b[0] <= ONE)
890: return;
891: if (b[0] == TWO) {
892: multwo:acur = 0;
893: while (a[++acur] != EOL) ;
894: mi = (a[acur - 1] == FIVE);
895: carry = 0;
896: ccur = acur;
897: while (acur >= 0) {
898: if ((bcur = a[--acur]) < ZERO)
899: continue;
900: bcur = bcur * 2 - ZERO + carry;
901: carry = 0;
902: if (bcur > NINE) {
903: carry = 1;
904: bcur -= NUMBASE;
905: }
906: a[acur] = bcur;
907: }
908: if (carry) {
909: acur = ccur;
910: if (acur > (STRLEN - 1)/*was 254*/) {
911: merr_raise (M75);
912: return;
913: }
914: while (acur >= 0) {
915: a[acur + 1] = a[acur];
916: acur--;
917: }
918: a[a[0] == MINUS] = ONE;
919: }
920: if (mi) {
921: if (carry)
922: ccur++;
923: acur = 0;
924: while (acur < ccur)
925: if (a[acur++] == POINT) {
926: a[--ccur] = EOL;
927: if (acur == ccur)
928: a[--ccur] = EOL;
929: return;
930: }
931: }
932: return;
933: }
934: }
935: if (a[1] == EOL) {
936: if (a[0] == ZERO) {
937: return;
938: }
939: if (a[0] <= ONE) {
940: stcpy (a, b);
941: return;
942: }
943: if (a[0] == TWO) {
944: stcpy (a, b);
945: goto multwo;
946: }
947: }
948: /* get length of strings and convert ASCII to decimal */
949: /* have a look at the signs */
950: if ((mi = (a[0] == MINUS))) {
951: a[0] = ZERO;
952: }
953: if (b[0] == MINUS) {
954: b[0] = ZERO;
955: toggle (mi);
956: }
957: carry = 0;
958: alen = 0;
959: while (a[alen] != EOL) {
960: a[alen] -= ZERO;
961: if (a[alen++] == point)
962: carry = alen;
963: }
964: /* append a point on the right side if there was none */
965: if (--carry < 0) {
966: carry = alen;
967: a[alen++] = point;
968: a[alen] = 0;
969: }
970: ccur = 0;
971: blen = 0;
972: while (b[blen] != EOL) {
973: b[blen] -= ZERO;
974: if (b[blen++] == point)
975: ccur = blen;
976: }
977: if (--ccur < 0) {
978: ccur = blen;
979: b[blen++] = point;
980: b[blen] = 0;
981: }
982: carry += ccur;
983: if (carry > (STRLEN - 3) /*was 252*/) {
984: a[0] = EOL;
985: merr_raise (M75);
986: return;
987: }
988: ccur = clen = alen + blen;
989: /* init c to zero */
990: while (ccur >= 0)
991: c[ccur--] = 0;
992: c[carry] = point;
993:
994: bcur = blen;
995: clen = alen + blen - 1;
996: carry = 0;
997: while (bcur > 0) {
998: if (b[--bcur] == point) {
999: continue;
1000: }
1001: if (c[clen] == point)
1002: clen--;
1003: acur = alen;
1004: ccur = clen--;
1005: while (acur > 0) {
1006: if (a[--acur] == point)
1007: continue;
1008: if (c[--ccur] == point)
1009: --ccur;
1010: tmpx = a[acur] * b[bcur] + c[ccur] + carry;
1011: carry = tmpx / NUMBASE;
1012: c[ccur] = tmpx % NUMBASE;
1013: }
1014: while (carry) {
1015: if (c[--ccur] == point)
1016: ccur--;
1017: if ((c[ccur] += carry) >= NUMBASE) {
1018: c[ccur] -= NUMBASE;
1019: carry = 1;
1020: } else
1021: carry = 0;
1022: }
1023: }
1024: /* copy result to a and convert it */
1025: a[ccur = clen = acur = (alen += blen)] = EOL;
1026: while (--ccur >= 0) {
1027: if (c[ccur] < NUMBASE)
1028: a[ccur] = c[ccur] + ZERO;
1029: else
1030: a[alen = ccur] = POINT;
1031: }
1032: /* oversize string */
1033: if (acur > STRLEN) {
1034: if (a[acur = STRLEN] >= FIVE) {
1035: int l1;
1036:
1037: l1 = STRLEN;
1038: if (a[l1] >= FIVE) {
1039: for (;;)
1040: {
1041: if (a[--l1] == POINT)
1042: l1--;
1043: if (l1 < (a[0] == MINUS)) {
1044: for (l1 = STRLEN; l1 > 0; l1--)
1045: a[l1] = a[l1 - 1];
1046: a[a[0] == MINUS] = ONE;
1047: break;
1048: }
1049: if ((++a[l1]) == (NINE + 1))
1050: a[l1] = ZERO;
1051: else
1052: break;
1053: }
1054: }
1055: }
1056: a[acur] = EOL;
1057: }
1058: /* remove trailing zeroes */
1059: if (acur >= alen) {
1060: while (a[--acur] == ZERO)
1061: a[acur] = EOL;
1062: }
1063: /* remove trailing point */
1064: if (a[acur] == POINT)
1065: a[acur] = EOL;
1066: /* remove leading zeroes */
1067: while (a[mi] == ZERO) {
1068: acur = mi;
1069: while ((a[acur] = a[acur + 1]) != EOL)
1070: acur++;
1071: }
1072: if (a[0] == EOL) {
1073: a[0] = ZERO;
1074: a[1] = EOL;
1075: mi = 0;
1076: }
1077: if (mi) {
1078: if (a[0] != ZERO) {
1079: acur = clen;
1080: while (acur > 0) {
1081: a[acur] = a[acur - 1];
1082: acur--;
1083: }
1084: }
1085: a[0] = MINUS;
1086: }
1087: return;
1088: }
1089: /******************************************************************************
1090: * for a detailed description of the method for the divisions see *
1091: * donald e.knuth 'the art of computer programming' vol.2 p.257 *
1092: ******************************************************************************/
1093: void mdiv (char *uu, char *v, short typ) /* divide string arithmetic */
1094: {
1095: char q[STRLEN + 2 /*was 257*/]; /* quotient */
1096: char u[2*(STRLEN + 1)/*was 512*/];/* intermediate result */
1097: char vv[STRLEN +1 /*was 256*/];
1098: short d,
1099: d1,
1100: k1,
1101: m,
1102: ulen,
1103: vlen,
1104: dpu,
1105: dpv,
1106: guess,
1107: mi,
1108: plus,
1109: v1;
1110: register long int i;
1111: register int j;
1112: register int k;
1113: register int carry = 0;
1114:
1115: #if !defined(_AIX)
1116: if (fp_mode) {
1117: double fp_uu;
1118: double fp_v;
1119:
1120: stcnv_m2c (uu);
1121: stcnv_m2c (v);
1122:
1123: fp_uu = atof (uu);
1124: fp_v = atof (v);
1125:
1126: switch (typ) {
1127:
1128: case '/':
1129: snprintf (uu, STRLEN - 1, fp_conversion, fp_uu / fp_v);
1130: break;
1131:
1132: case '\\':
1133: snprintf (uu, STRLEN - 1, "%ld\201", (long) (fp_uu / fp_v));
1134: break;
1135:
1136: case '#':
1137: snprintf (uu, STRLEN - 1, "%ld\201", (((long) fp_uu) % ((long) fp_v)));
1138: /*snprintf (uu, STRLEN - 1, "%ld\201", ((long) fp_uu < 0 ? (((long) fp_uu % (long) fp_v) + (long) fp_v) % (long) fp_v : (long) fp_uu % (long) fp_v)); */
1139: break;
1140: }
1141:
1142: trim_decimal (uu);
1143:
1144: return;
1145: }
1146: #endif
1147:
1148:
1149: if (merr () > OK)
1150: return; /* avoid nonsense in recursion */
1151: if (uu[0] == ZERO)
1152: return;
1153: #ifdef NEVER
1154: /* should be faster on DIV 2, but causes some error
1155: * in connection with SQRT */
1156: if (v[1] == EOL && typ == '/') {
1157: if (v[0] == ONE)
1158: return;
1159: if (v[0] == TWO) {
1160: carry = 0;
1161: k = (-1);
1162: k1 = (-1);
1163: while ((i = uu[++k]) != EOL) {
1164: if (i < ZERO) {
1165: if (i == POINT) {
1166: k1 = k;
1167: if (k + zprecise < STRLEN)
1168: uu[k + zprecise] = EOL;
1169: }
1170: continue;
1171: }
1172: if (i == EOL)
1173: break;
1174: if (i & 01)
1175: j = NUMBASE;
1176: i = (i + ZERO + carry) / 2;
1177: carry = j;
1178: j = 0;
1179: uu[k] = i;
1180: }
1181: j = (uu[0] == MINUS);
1182: if (uu[j] == ZERO) {
1183: while (j < k) {
1184: uu[j] = uu[j + 1];
1185: j++;
1186: }
1187: k--;
1188: }
1189: if (carry && k < (STRLEN - 2) /*was 253*/) {
1190: if (k1 < 0) {
1191: k1 = k;
1192: uu[k++] = POINT;
1193: }
1194: uu[k++] = FIVE;
1195: uu[k] = EOL;
1196: }
1197: return;
1198: }
1199: }
1200: #endif /* NEVER */
1201: /* look at the signs */
1202: stcpy (u, uu);
1203: mi = 0;
1204: plus = 0;
1205: if (typ != '#') {
1206: if (u[0] == MINUS) {
1207: u[0] = ZERO;
1208: mi = 1;
1209: }
1210: if (v[0] == MINUS) {
1211: v[0] = ZERO;
1212: toggle (mi);
1213: }
1214: } else {
1215: stcpy (vv, v);
1216: if (u[0] == MINUS) {
1217: u[0] = ZERO;
1218: plus = 1;
1219: }
1220: if (v[0] == MINUS) {
1221: v[0] = ZERO;
1222: mi = 1;
1223: toggle (plus);
1224: }
1225: }
1226: /* convert from ASCII to 'number' */
1227: i = 0;
1228: dpv = (-1);
1229: k = 0;
1230: while ((j = v[i]) != EOL) {
1231: j -= ZERO;
1232: if (j == point)
1233: dpv = i;
1234: if (j == 0)
1235: k++;
1236: v[i++] = j;
1237: }
1238:
1239: v[vlen = i] = 0;
1240: v[i + 1] = 0;
1241: v[i + 2] = 0;
1242: if (v[0] != 0) {
1243: while (i >= 0) {
1244: v[i + 1] = v[i];
1245: i--;
1246: }
1247: v[0] = 0;
1248: dpv++;
1249: } else {
1250: vlen--;
1251: }
1252: d1 = 0;
1253:
1254: i = 0;
1255: dpu = (-1);
1256: while (u[i] != EOL) {
1257: u[i] -= ZERO;
1258: if (u[i] == point)
1259: dpu = i;
1260: i++;
1261: }
1262: if (dpu < 0) {
1263: u[dpu = i++] = point;
1264: }
1265: /* u[ulen=i]=0; u[i+1]=0; u[i+2]=0; */
1266: ulen = i;
1267: while (i < 512)
1268: u[i++] = 0;
1269: i = ulen; /* somehow that's necessary - sometimes I check why */
1270: if (u[0] != 0) {
1271: while (i >= 0) {
1272: u[i + 1] = u[i];
1273: i--;
1274: }
1275: u[0] = 0;
1276: dpu++;
1277: } else {
1278: ulen--;
1279: }
1280: if ((vlen + zprecise) > STRLEN && (dpv + zprecise) < vlen)
1281: vlen -= zprecise;
1282:
1283: if (dpv > 0) { /* make v an integer *//* shift v */
1284: d1 = vlen - dpv;
1285: for (i = dpv; i < vlen; i++)
1286: v[i] = v[i + 1];
1287: vlen--;
1288: /* remove leading zeroes */
1289: while (v[1] == 0) {
1290: for (i = 1; i <= vlen; i++)
1291: v[i] = v[i + 1];
1292: vlen--;
1293: }
1294: v[vlen + 1] = 0;
1295: v[vlen + 2] = 0;
1296: /* shift u */
1297: i = dpu;
1298: for (j = 0; j < d1; j++) {
1299: if (i >= ulen) {
1300: u[i + 1] = 0;
1301: ulen++;
1302: }
1303: u[i] = u[i + 1];
1304: i++;
1305: }
1306: u[i] = point;
1307: dpu = i;
1308: }
1309: d = dpu + 1 - ulen;
1310: if (dpv > dpu)
1311: d += dpv - dpu;
1312: if (typ == '/')
1313: d += zprecise;
1314: if ((d + ulen) > STRLEN) {
1315: u[0] = EOL;
1316: merr_raise (M75);
1317: return;
1318: }
1319: while (d > 0) {
1320: u[++ulen] = 0;
1321: d--;
1322: }
1323: /* normalize */
1324: if ((d = NUMBASE / (v[1] + 1)) > 1) {
1325: i = ulen;
1326: carry = 0;
1327: while (i > 0) {
1328: if (u[i] != point) {
1329: carry += u[i] * d;
1330: u[i] = carry % NUMBASE;
1331: carry = carry / NUMBASE;
1332: }
1333: i--;
1334: }
1335: u[0] = carry;
1336: i = vlen;
1337: carry = 0;
1338: while (i > 0) {
1339: carry += v[i] * d;
1340: v[i] = carry % NUMBASE;
1341: carry = carry / NUMBASE;
1342: i--;
1343: }
1344: v[0] = carry;
1345: }
1346: /* initialize */
1347: j = 0;
1348: m = ulen - vlen + 1;
1349: if (m <= dpu)
1350: m = dpu + 1;
1351: for (i = 0; i <= m; q[i++] = ZERO) ;
1352: if (typ == '#') {
1353: m = dpu - vlen;
1354: }
1355: v1 = v[1];
1356:
1357: while (j < m) {
1358: if (u[j] != point) { /* calculate guess */
1359: if ((k = u[j] * NUMBASE + (u[j + 1] == point ? u[j + 2] : u[j + 1])) == 0) {
1360: j++;
1361: continue;
1362: }
1363: k1 = (u[j + 1] == point || u[j + 2] == point ? u[j + 3] : u[j + 2]);
1364: guess = (u[j] == v1 ? (NUMBASE - 1) : k / v1);
1365: if (v[2] * guess > (k - guess * v1) * NUMBASE + k1) {
1366: guess--;
1367: if (v[2] * guess > (k - guess * v1) * NUMBASE + k1)
1368: guess--;
1369: }
1370: /* multiply and subtract */
1371: i = vlen;
1372: carry = 0;
1373: k = j + i;
1374: if (j < dpu && k >= dpu)
1375: k++;
1376: while (k >= 0) {
1377: if (u[k] == point)
1378: k--;
1379: if (i >= 0) {
1380: u[k] -= v[i--] * guess + carry;
1381: } else {
1382: if (carry == 0)
1383: break;
1384: u[k] -= carry;
1385: }
1386: carry = 0;
1387: while (u[k] < 0) {
1388: u[k] += NUMBASE;
1389: carry++;
1390: }
1391: k--;
1392: }
1393: /* test remainder / add back */
1394: if (carry) {
1395: guess--;
1396: i = vlen;
1397: carry = 0;
1398: k = j + i;
1399: if (j < dpu && k >= dpu)
1400: k++;
1401: while (k >= 0) {
1402: if (u[k] == point)
1403: k--;
1404: if (i >= 0) {
1405: u[k] += v[i--] + carry;
1406: } else {
1407: if (carry == 0)
1408: break;
1409: u[k] += carry;
1410: }
1411: carry = u[k] / NUMBASE;
1412: u[k] = u[k] % NUMBASE;
1413: k--;
1414: }
1415: }
1416: q[j++] = guess + ZERO;
1417: u[0] = 0;
1418: } else {
1419: q[j++] = POINT;
1420: }
1421: }
1422: /* unnormalize */
1423: if (typ != '#') {
1424: i = 0;
1425: while (i <= m) {
1426: if ((u[i] = q[i]) == POINT)
1427: dpv = i;
1428: i++;
1429: }
1430: k = vlen;
1431: k1 = dpv;
1432: while (k-- > 0) {
1433: while (k1 <= 0) {
1434: for (i = (++m); i > 0; i--)
1435: u[i] = u[i - 1];
1436: k1++;
1437: u[0] = ZERO;
1438: }
1439: u[k1] = u[k1 - 1];
1440: u[--k1] = POINT;
1441: dpv = k1;
1442: }
1443: u[m] = EOL;
1444: /* rounding */
1445:
1446: if (typ != '/')
1447: u[dpv + 1] = EOL;
1448: else {
1449: k = dpv + zprecise;
1450: k1 = u[k + 1] >= FIVE;
1451: u[k + 1] = EOL;
1452: if (k1) {
1453: do {
1454: if (u[k] != POINT) {
1455: if ((carry = (u[k] == NINE)))
1456: u[k] = ZERO;
1457: else
1458: u[k]++;
1459: }
1460: k--;
1461: } while (carry);
1462: }
1463: }
1464: } else { /* return the remainder */
1465: carry = 0;
1466: if (d > 1) {
1467: for (i = 0; i <= ulen; i++) {
1468: if (u[i] == point) {
1469: u[i] = POINT;
1470: dpu = i;
1471: } else {
1472: u[i] = (j = carry + u[i]) / d + ZERO;
1473: carry = j % d * NUMBASE;
1474: }
1475: }
1476: } else {
1477: for (i = 0; i <= ulen; i++)
1478: if (u[i] == point)
1479: u[dpu = i] = POINT;
1480: else
1481: u[i] += ZERO;
1482: }
1483: u[i] = EOL;
1484: if (d1 > 0) {
1485: u[i + 1] = EOL;
1486: u[i + 2] = EOL;
1487: i = dpu;
1488: for (j = 0; j < d1; j++) {
1489: u[i] = u[i - 1];
1490: i--;
1491: }
1492: u[i] = POINT;
1493: }
1494: }
1495: /* remove trailing zeroes */
1496: i = 0;
1497: k = (-1);
1498: while (u[i] != EOL) {
1499: if (u[i] == POINT)
1500: k = i;
1501: i++;
1502: }
1503: i--;
1504: if (k >= 0) {
1505: while (u[i] == ZERO && i > k)
1506: u[i--] = EOL;
1507: }
1508: /* remove trailing point */
1509: if (u[i] == POINT)
1510: u[i] = EOL;
1511: /* remove leading zeroes */
1512: while (u[0] == ZERO) {
1513: i = 0;
1514: while ((u[i] = u[i + 1]) != EOL)
1515: i++;
1516: }
1517: if (u[0] == EOL) {
1518: u[0] = ZERO;
1519: u[1] = EOL;
1520: mi = 0;
1521: }
1522: if ((mi || plus) && (u[0] != ZERO)) {
1523: if (mi != plus) {
1524: i = stlen (u) + 1;
1525: do {
1526: u[i] = u[i - 1];
1527: i--;
1528: } while (i > 0);
1529: u[0] = MINUS;
1530: }
1531: if (plus)
1532: add (u, vv);
1533: }
1534: stcpy (uu, u);
1535: return;
1536: } /* end div() */
1537: /******************************************************************************/
1538: void power (char *a, char *b) /* raise a to the b-th power */
1539: {
1540: char c[STRLEN + 2/*was 257*/];
1541: char d[4*(STRLEN + 1)/*was 1024*/];/* 257 should be sufficient, but somewhere there */
1542:
1543: /* is a memory leak resulting in wrong results */
1544: /* with fractional powers, e.g. 2**(3/7) */
1545: /* even a value of 513 is too small */
1546: char e[STRLEN + 2/*was 257*/];
1547: register long i;
1548: register long j;
1549:
1550: #if !defined(_AIX)
1551: if (fp_mode) {
1552: double fp_a;
1553: double fp_b;
1554:
1555: stcnv_m2c (a);
1556: stcnv_m2c (b);
1557:
1558: fp_a = atof (a);
1559: fp_b = atof (b);
1560:
1561: snprintf (a, STRLEN - 1, fp_conversion, pow (fp_a, fp_b));
1562:
1563: trim_decimal (a);
1564:
1565: return;
1566: }
1567: #endif
1568:
1569:
1570: if (merr () > OK)
1571: return; /* avoid nonsense in recursion */
1572: /* if zero or one there's not much to do */
1573: if (a[1] == EOL) {
1574: if (a[0] == ZERO) {
1575: if (b[1] == EOL && b[0] == ZERO)
1576: merr_raise (M9);
1577: return;
1578: } /* undef */
1579: if (a[0] == ONE)
1580: return;
1581: }
1582: if (b[0] == MINUS) {
1583: power (a, &b[1]);
1584: if (merr () == M75) {
1585: a[0] = ZERO;
1586: a[1] = EOL;
1587: merr_raise (OK);
1588: return;
1589: }
1590: stcpy (c, a);
1591: a[0] = ONE;
1592: a[1] = EOL;
1593: mdiv (a, c, '/');
1594: return;
1595: }
1596: if (b[1] == EOL) {
1597: switch (b[0]) {
1598: case ZERO:
1599: a[0] = ONE;
1600: a[1] = EOL;
1601: case ONE:
1602: return;
1603: case TWO:
1604: stcpy (c, a);
1605: mul (a, c);
1606: return;
1607: }
1608: }
1609: /* look for decimal point */
1610: e[0] = EOL;
1611: i = 0;
1612: while (b[i] != EOL) {
1613: if (b[i] == POINT) {
1614: if (a[0] == MINUS) {
1615: merr_raise (M9);
1616: return;
1617: } /* undefined case */
1618: if (b[i + 1] == FIVE && b[i + 2] == EOL) { /* half-integer: extra solution */
1619: if (i) {
1620: stcpy (c, b);
1621: add (b, c);
1622: power (a, b);
1623: if (merr () > OK) {
1624: a[0] = ONE;
1625: a[1] = EOL;
1626: return;
1627: }
1628: }
1629: g_sqrt (a);
1630: return;
1631: }
1632: stcpy (e, &b[i]);
1633: b[i] = EOL;
1634: break;
1635: }
1636: i++;
1637: }
1638: stcpy (d, a);
1639: i = intexpr (b);
1640: if (merr () == MXNUM)
1641: return;
1642: /* do it with a small number of multiplications */
1643: /* the number of multiplications is not optimum, but reasonably small */
1644: /* see donald e. knuth "The Art of Computer Programming" Vol.II p.441 */
1645: if (i == 0) {
1646: a[0] = ONE;
1647: a[1] = EOL;
1648: } else {
1649: j = 1;
1650: while (j < i) {
1651: j = j * 2;
1652: if (j < 0) {
1653: merr_raise (MXNUM);
1654: return;
1655: }
1656: }
1657: if (i != j)
1658: j = j / 2;
1659: j = j / 2;
1660: while (j) {
1661: stcpy (c, a);
1662: mul (a, c);
1663: if (i & j) {
1664: stcpy (c, d);
1665: mul (a, c);
1666: }
1667: j = j / 2;
1668: if (merr () == MXNUM)
1669: return;
1670: }
1671: if (e[0] == EOL)
1672: return;
1673: }
1674: /* non integer exponent */
1675: /* state of computation at this point: */
1676: /* d == saved value of a */
1677: /* a == d^^int(b); */
1678: /* e == frac(b); */
1679: {
1680: char Z[STRLEN + 2/*was 257*/];
1681:
1682: /* is fraction the inverse of an integer? */
1683: Z[0] = ONE;
1684: Z[1] = EOL;
1685: stcpy (c, e);
1686: mdiv (Z, c, '/');
1687: i = 0;
1688: for (;;)
1689: {
1690: if ((j = Z[i++]) == EOL) {
1691: j = intexpr (Z);
1692: break;
1693: }
1694: if (j != POINT)
1695: continue;
1696: j = intexpr (Z);
1697: if (Z[i] == NINE)
1698: j++;
1699: break;
1700: }
1701: Z[0] = ONE;
1702: Z[1] = EOL;
1703: lintstr (c, j);
1704: mdiv (Z, c, '/');
1705: /* if integer */
1706:
1707: if (stcmp (Z, e) == 0) {
1708: stcpy (Z, d);
1709: root (Z, j);
1710: if (merr () <= OK) {
1711: mul (a, Z);
1712: return;
1713: } /* on error try other method */
1714: merr_raise (OK);
1715: }
1716: Z[0] = ONE;
1717: Z[1] = EOL;
1718: zprecise += 2;
1719: for (;;)
1720: {
1721: c[0] = TWO;
1722: c[1] = EOL;
1723: mul (e, c);
1724: g_sqrt (d);
1725: if (e[0] == ONE) {
1726: e[0] = ZERO;
1727: numlit (e);
1728: stcpy (c, d);
1729: mul (Z, c);
1730: mround (Z, zprecise);
1731: }
1732: if (e[0] == ZERO)
1733: break;
1734: i = 0;
1735: j = (d[0] == ONE ? ZERO : NINE);
1736: for (;;) {
1737: ++i;
1738: if (d[i] != j && d[i] != '.')
1739: break;
1740: }
1741: if (d[i] == EOL || (i > zprecise))
1742: break;
1743: }
1744: zprecise -= 2;
1745: mul (a, Z);
1746: mround (a, zprecise + 1);
1747: }
1748: return;
1749: } /* end power() */
1750: /******************************************************************************/
1751: void g_sqrt (char *a) /* square root */
1752: {
1753: register int i,
1754: ch;
1755:
1756: if (a[0] == ZERO)
1757: return;
1758: if (a[0] == MINUS) {
1759: merr_raise (M9);
1760: return;
1761: }
1762: if (merr () > OK)
1763: return; /* avoid nonsense in recursion */
1764: {
1765: char tmp1[STRLEN +2 /*was 257*/],
1766: tmp2[STRLEN +2 /*was 257*/],
1767: XX[STRLEN +2 /*was 257*/],
1768: XXX[STRLEN +2 /*was 257*/];
1769:
1770: stcpy (XX, a);
1771: /* look for good initial value */
1772: if (a[0] > ONE || (a[0] == ONE && a[1] != POINT)) {
1773: i = 0;
1774: while ((ch = a[i++]) != EOL) {
1775: if (ch == POINT)
1776: break;
1777: }
1778: if ((i = (i + 1) / 2))
1779: a[i] = EOL;
1780: } else if (a[0] != ONE) {
1781: a[0] = ONE;
1782: a[1] = EOL;
1783: }
1784: /* "Newton's" algorithm with quadratic convergence */
1785: zprecise++;
1786: do {
1787: stcpy (XXX, a);
1788: stcpy (tmp1, XX);
1789: stcpy (tmp2, a);
1790: mdiv (tmp1, tmp2, '/');
1791: if (merr () > OK)
1792: break;
1793: add (a, tmp1);
1794: tmp2[0] = TWO;
1795: tmp2[1] = EOL;
1796: mdiv (a, tmp2, '/');
1797: } while (comp (a, XXX));
1798: zprecise--;
1799: return;
1800: }
1801: } /* end g_sqrt() */
1802: /******************************************************************************/
1803: void root (char *a, long n) /* n.th root */
1804: {
1805: register int i,
1806: ch;
1807:
1808: if (a[0] == ZERO)
1809: return;
1810: if (a[0] == MINUS || n == 0) {
1811: merr_raise (M9);
1812: return;
1813: }
1814: if (merr () > OK)
1815: return; /* avoid nonsense in recursion */
1816: {
1817: char tmp1[STRLEN +2/*was 257*/],
1818: tmp2[STRLEN +2/*was 257*/],
1819: XX[STRLEN +2/*was 257*/],
1820: XXX[STRLEN +2/*was 257*/];
1821: short again;
1822:
1823: stcpy (XX, a);
1824: /* look for good initial value */
1825: if (a[0] > ONE || (a[0] == ONE && a[1] != POINT)) {
1826: i = 0;
1827: while ((ch = a[i++]) != EOL && ch != POINT) ;
1828: if ((i = (i + n - 2) / n) > 0) {
1829: a[0] = THREE;
1830: a[i] = EOL;
1831: }
1832: } else if (a[0] != ONE) {
1833: a[0] = ONE;
1834: a[1] = EOL;
1835: }
1836: /* "Newton's" algorithm with quadratic convergence */
1837:
1838: if (zprecise <= 3)
1839: again = 0; /* speedup div with small zprec. */
1840: else {
1841: again = zprecise;
1842: zprecise = 2;
1843: }
1844: second:;
1845: zprecise++;
1846: for (;;) {
1847: stcpy (XXX, a);
1848: lintstr (tmp1, n - 1);
1849: stcpy (tmp2, a);
1850: power (tmp2, tmp1);
1851: stcpy (tmp1, XX);
1852: mdiv (tmp1, tmp2, '/');
1853: if (merr () > OK)
1854: break;
1855: lintstr (tmp2, n - 1);
1856: mul (a, tmp2);
1857: add (a, tmp1);
1858: lintstr (tmp2, n);
1859: mdiv (a, tmp2, '/');
1860: stcpy (tmp2, a);
1861: mdiv (XXX, tmp2, '/');
1862: tmp2[0] = ONE;
1863: if (zprecise <= 0)
1864: tmp2[1] = EOL;
1865: else {
1866: tmp2[1] = POINT;
1867: for (i = 2; i < zprecise; i++)
1868: tmp2[i] = ZERO;
1869: tmp2[i++] = FIVE;
1870: tmp2[i] = EOL;
1871: }
1872: if (!comp (XXX, tmp2))
1873: continue;
1874: if (zprecise <= 0)
1875: break;
1876: tmp2[0] = POINT;
1877: for (i = 1; i < zprecise; i++)
1878: tmp2[i] = NINE;
1879: tmp2[i - 1] = FIVE;
1880: tmp2[i] = EOL;
1881: if (comp (tmp2, XXX))
1882: break;
1883: }
1884: zprecise--;
1885: if (again) {
1886: zprecise = again;
1887: again = 0;
1888: goto second;
1889: }
1890: return;
1891: }
1892: } /* end root() */
1893: /******************************************************************************/
1894: int numlit (char *str)
1895: {
1896: long j,
1897: mi = 0,
1898: pointx = (-1),
1899: expflg = 0;
1900: long val,
1901: exp = 0L;
1902: int result;
1903: register int i = 0;
1904: register int ch;
1905:
1906: result = 0;
1907: if (str[0] < ONE) {
1908: if (str[0] == EOL) {
1909: str[0] = ZERO;
1910: str[1] = EOL;
1911: return (0);
1912: }
1913: /* compact signs */
1914: while (str[i] == PLUS || str[i] == MINUS)
1915: if (str[i++] == MINUS)
1916: mi++;
1917: if ((j = (mi &= 01)))
1918: str[0] = MINUS;
1919: /* compact leading zeroes */
1920: while (str[i] == ZERO)
1921: i++;
1922: if (i > j)
1923: stcpy (&str[j], &str[i]);
1924: if (str[mi] == EOL) {
1925: str[0] = ZERO;
1926: str[1] = EOL;
1927: return (0);
1928: }
1929: i = mi;
1930: }
1931: while ((ch = str[i]) <= NINE && ch >= ZERO)
1932: i++;
1933: if ((result = unit (&str[i]))) {
1934: if (i == mi) {
1935: str[0] = '0';
1936: i = 1;
1937: }
1938: ch = str[i] = EOL;
1939: }
1940: if (ch == EOL)
1941: return (result);
1942: if (ch == POINT) {
1943: pointx = i++;
1944: while ((ch = str[i]) <= NINE && ch >= ZERO)
1945: i++;
1946: if ((result = unit (&str[i])))
1947: ch = str[i] = EOL;
1948: if (ch == EOL) {
1949: i = pointx;
1950: goto point0;
1951: }
1952: }
1953: /* check for zero mantissa */
1954: j = 0;
1955: while (j < i) {
1956: if (str[j] > ZERO) {
1957: j = (-1);
1958: break;
1959: }
1960: j++;
1961: }
1962: if (j >= 0) {
1963: str[0] = ZERO;
1964: str[1] = EOL;
1965: return (result);
1966: }
1967: /* search for exponent */
1968: for (; ch != EOL; ch = str[++i]) {
1969: if (ch <= NINE && ch >= ZERO) {
1970: if (expflg) {
1971: ch -= ZERO;
1972: val = exp * NUMBASE + ch;
1973: /* check for numeric overflow */
1974: if (((val - ch) / NUMBASE) != exp) {
1975: merr_raise (MXNUM);
1976: return (0);
1977: }
1978: exp = val;
1979: }
1980: continue;
1981: }
1982: if (expflg) {
1983: if (ch == MINUS) {
1984: if (str[i + 1] == '-') {
1985: merr_raise (INVEXPR);
1986: return (0);
1987: }
1988: expflg = (-expflg);
1989: continue;
1990: }
1991: if (ch == PLUS)
1992: continue;
1993: }
1994: if ((result = unit (&str[i])))
1995: ch = str[i] = EOL;
1996: str[i] = EOL;
1997: if (ch == 'E' || (lowerflag && ch == 'e')) {
1998: expflg++;
1999: continue;
2000: }
2001: break;
2002: }
2003: /* append a point at the right end */
2004: if (expflg) {
2005: if (pointx < 0) {
2006: i = mi;
2007: while (str[i] != EOL)
2008: i++;
2009: if (i >= (STRLEN - 1)/*was 254*/) {
2010: str[STRLEN] = EOL;
2011: merr_raise (M75);
2012: return (0);
2013: }
2014: str[pointx = i] = POINT;
2015: str[++i] = EOL;
2016: }
2017: /* if exp shift decimal point */
2018: if (expflg > 0) {
2019: while (exp-- > 0) {
2020: if ((str[pointx] = str[pointx + 1]) == EOL) {
2021: if (pointx >= (STRLEN - 1)/*was 254*/)
2022: break;
2023: str[pointx] = ZERO;
2024: str[pointx + 1] = str[pointx + 2] = EOL;
2025: }
2026: pointx++;
2027: }
2028: if (pointx >= (STRLEN - 1)/*was 254*/) {
2029: str[STRLEN] = EOL;
2030: merr_raise (M75);
2031: return (0);
2032: }
2033: str[pointx] = POINT;
2034: } else { /* (expflg<0) */
2035: while (exp-- > 0) {
2036: if (--pointx < 0) {
2037: i = pointx = 0;
2038: while (str[i++] != EOL) ;
2039: if (i >= (STRLEN - 1)/*was 254*/) {
2040: merr_raise (M75);
2041: return (0);
2042: }
2043: while (i-- > 0)
2044: str[i + 1] = str[i];
2045: str[0] = ZERO;
2046: }
2047: str[pointx + 1] = str[pointx];
2048: }
2049: str[pointx] = POINT;
2050: }
2051: }
2052: if ((i = pointx) >= 0) {
2053:
2054: point0:
2055:
2056: while (str[++i] != EOL) ;
2057:
2058: i--;
2059: while (str[i] == ZERO)
2060: str[i--] = EOL; /* remove trailing zeroes */
2061: if (str[i] == POINT)
2062: str[i] = EOL; /* remove trailing point */
2063: }
2064: if (str[mi] == EOL) {
2065: str[0] = ZERO;
2066: str[1] = EOL;
2067: }
2068: return (result);
2069: }
2070: /******************************************************************************/
2071: int unit (char *str)
2072: /**
2073: * str is interpreted as a currency
2074: * symbol
2075: * return value: 1=EUR, 4=DM, ...
2076: * 0=other */
2077:
2078: {
2079: char ch;
2080:
2081: ch = str[0];
2082: if ((ch < 'A') || (ch > 'P'))
2083: return 0;
2084: switch (ch) {
2085: case 'E':
2086: if (str[1] == 'U' && str[2] == 'R')
2087: return 1;
2088: if (str[1] == 'S' && str[2] == 'P')
2089: return 5;
2090: return 0;
2091: case 'D':
2092: if (str[1] == 'M')
2093: return 4;
2094: if (str[1] == 'E' && str[2] == 'M')
2095: return 4;
2096: return 0;
2097: case 'A':
2098: if (str[1] == 'T' && str[2] == 'S')
2099: return 2;
2100: return 0;
2101: case 'B':
2102: if (str[1] == 'F' && str[2] == 'R')
2103: return 3;
2104: return 0;
2105: case 'F':
2106: if (str[1] == 'F')
2107: return 7;
2108: if (str[1] == 'M' && str[2] == 'K')
2109: return 6;
2110: if (str[1] == 'R' && str[2] == 'F')
2111: return 7;
2112: return 0;
2113: case 'I':
2114: if (str[1] == 'E' && str[2] == 'P')
2115: return 8;
2116: if (str[1] == 'T' && str[2] == 'L')
2117: return 9;
2118: return 0;
2119: case 'N':
2120: if (str[1] == 'L' && str[2] == 'G')
2121: return 10;
2122: return 0;
2123: case 'P':
2124: if (str[1] == 'T' && str[2] == 'E')
2125: return 11;
2126: }
2127: return 0;
2128: }
2129: /******************************************************************************/
2130: long intexpr (char *str)
2131: {
2132: {
2133: register int ch;
2134: register int i = 0;
2135: register long value;
2136: register long newval;
2137: short minus = FALSE;
2138:
2139: if ((ch = str[0]) == MINUS) {
2140: ch = str[1];
2141: minus = TRUE;
2142: i = 1;
2143: }
2144: if (ch >= ZERO && ch <= NINE) {
2145: value = ch - ZERO;
2146: while ((ch = str[++i]) >= ZERO && ch <= NINE) {
2147: newval = value * NUMBASE;
2148: if (newval < 0 || ((newval / NUMBASE) != value)) {
2149: merr_raise (MXNUM);
2150: return (minus ? -1 : 1);
2151: };
2152: newval += ((long) ch - ZERO);
2153: if (newval < 0) {
2154: merr_raise (MXNUM);
2155: return (minus ? -1 : 1);
2156: };
2157: value = newval;
2158: }
2159: if (minus)
2160: value = (-value);
2161: if (ch == EOL)
2162: return value;
2163: } else if (ch != ZERO && ch != PLUS && ch != MINUS && ch != POINT)
2164: return 0L;
2165: }
2166: {
2167: register int ch;
2168: register int i = 0;
2169: register long value;
2170: register long newval;
2171: char tmp[STRLEN +2/*was 257*/];
2172:
2173: stcpy (tmp, str);
2174: numlit (tmp);
2175: i = (tmp[0] == MINUS);
2176: if (merr () == MXNUM)
2177: return (i ? -1 : 1);
2178: value = 0L;
2179: while ((ch = tmp[i++]) >= ZERO && ch <= NINE) {
2180: newval = value * NUMBASE;
2181: if (newval < 0 || ((newval / NUMBASE) != value)) {
2182: merr_raise (MXNUM);
2183: value = 1;
2184: break;
2185: }
2186: newval += ((long) ch - ZERO);
2187: if (newval < 0) {
2188: merr_raise (MXNUM);
2189: value = 1;
2190: break;
2191: }
2192: value = newval;
2193: }
2194: if (tmp[0] == MINUS)
2195: value = (-value);
2196: return value;
2197: }
2198: } /* end of intexpr */
2199: /******************************************************************************/
2200: short int tvexpr (char *str) /* str is interpreted as truth valued expression */
2201: {
2202: if (str[0] > ZERO && str[0] <= NINE) {
2203: str[0] = ONE;
2204: str[1] = EOL;
2205: return TRUE;
2206: }
2207: if (str[1] == EOL) {
2208: str[0] = ZERO;
2209: return FALSE;
2210: } {
2211: register int ch;
2212: register int i = 0;
2213: register int pointx = FALSE;
2214: register int sign = FALSE;
2215:
2216: for (;;)
2217: {
2218: if ((ch = str[i]) > ZERO && ch <= NINE) {
2219: str[0] = ONE;
2220: str[1] = EOL;
2221: return TRUE;
2222: }
2223: i++;
2224: if ((ch == PLUS || ch == MINUS) && sign == FALSE)
2225: continue;
2226: sign = TRUE;
2227: if (ch == ZERO)
2228: continue;
2229: if (ch == POINT && pointx == FALSE) {
2230: sign = TRUE;
2231: pointx = TRUE;
2232: continue;
2233: }
2234: str[0] = ZERO;
2235: str[1] = EOL;
2236: return FALSE;
2237: }
2238: }
2239: }
2240:
2241: /******************************************************************************/
2242: void m_op (char *a, char *b, short op)
2243: {
2244: int atyp,
2245: btyp; /* DM/EUR currency types */
2246: char tmp[(STRLEN + 1)/*was 256*/];
2247:
2248: switch (op & 0177) { /* binary operators */
2249: case '_':
2250: if (op & 0200)
2251: break; /* NOT_OPERAND */
2252: if (stcat (a, b) == 0) {
2253: merr_raise (M75);
2254: }
2255: return;
2256: case '=':
2257: if (stcmp (a, b))
2258: *a = ZERO;
2259: else
2260: *a = ONE;
2261: if (op & 0200)
2262: toggle (*a); /* NOT_OPERAND */
2263: a[1] = EOL;
2264: return;
2265: case '[':
2266: if (*b == EOL || find (a, b))
2267: *a = ONE;
2268: else
2269: *a = ZERO;
2270: if (op & 0200)
2271: toggle (*a); /* NOT_OPERAND */
2272: a[1] = EOL;
2273: return;
2274: case ']':
2275: if (*b == EOL) {
2276: if (*a == EOL)
2277: *a = ZERO;
2278: else
2279: *a = ONE;
2280: }
2281: /* frequent special case */
2282: else if (stcmp (a, b) <= 0)
2283: *a = ZERO;
2284: else
2285: *a = ONE;
2286: if (op & 0200)
2287: toggle (*a); /* NOT_OPERAND */
2288: a[1] = EOL;
2289: return;
2290: } /* end switch */
2291: atyp = numlit (a);
2292: if (op == '-') {
2293: stcpy (&tmp[1], b);
2294: tmp[0] = '-';
2295: op = '+';
2296: } else
2297: stcpy (tmp, b);
2298: btyp = numlit (tmp);
2299: switch (op & 0177) { /* binary operators, NOT OMITTED */
2300: case '+':
2301: if (op & 0200) {
2302: merr_raise (ASSIGNER);
2303: return;
2304: } /* NOT_OPERAND */
2305: #ifdef EUR2DEM
2306: if (atyp != btyp) {
2307: char tmp2[256];
2308:
2309: if ((atyp == 0) && (a[0] == '0'))
2310: atyp = btyp; /* zero is any currency */
2311: if ((btyp == 0) && (tmp[0] == '0'))
2312: btyp = atyp; /* zero is any currency */
2313: if (atyp && btyp) {
2314: if (atyp > 1) {
2315: stcpy (tmp2, EUR2WHR[atyp]);
2316: mul (tmp, tmp2);
2317: }
2318: if (btyp > 1) {
2319: zprecise += 4;
2320: stcpy (tmp2, EUR2WHR[btyp]);
2321: mdiv (tmp, tmp2, '/');
2322: zprecise -= 4;
2323: }
2324: } else if (atyp != btyp && typemmflag) {
2325: merr_raise (TYPEMISMATCH);
2326: return;
2327: }
2328: }
2329: #endif /* EUR2DEM */
2330: add (a, tmp);
2331: plus02:
2332: #ifdef EUR2DEM
2333: if (atyp == 0)
2334: break;
2335: if (atyp != btyp)
2336: cond_round (a, zprecise);
2337: if (atyp)
2338: stcat (a, WHR[atyp]);
2339: #endif /* EUR2DEM */
2340: break;
2341:
2342: case '*':
2343: if (op & 0200) {
2344: merr_raise (ASSIGNER);
2345: return;
2346: } /* NOT_OPERAND */
2347: #ifdef EUR2DEM
2348: if (btyp && atyp == 0) {
2349: atyp = btyp;
2350: btyp = 0;
2351: }
2352: if (atyp && btyp) {
2353: if (typemmflag) {
2354: merr_raise (TYPEMISMATCH);
2355: return;
2356: }
2357: atyp = btyp = 0;
2358: }
2359: #endif /* EUR2DEM */
2360: mul (a, tmp);
2361:
2362: #ifdef EUR2DEM
2363: if (atyp) {
2364: cond_round (a, zprecise);
2365: stcat (a, WHR[atyp]);
2366: }
2367: #endif /* EUR2DEM */
2368: break;
2369:
2370: case '/':
2371: case '\\':
2372: case '#':
2373:
2374: if (op & 0200) {
2375: merr_raise (ASSIGNER);
2376: return;
2377: } /* NOT_OPERAND */
2378: #ifdef EUR2DEM
2379: if (atyp != btyp) {
2380: char tmp2[(STRLEN + 1)/*was 256*/];
2381:
2382: if (atyp && btyp) {
2383: if (op == '#') {
2384: if (atyp > 1) {
2385: stcpy (tmp2, EUR2WHR[atyp]);
2386: mul (tmp, tmp2);
2387: }
2388: if (btyp > 1) {
2389: stcpy (tmp2, EUR2WHR[btyp]);
2390: mdiv (tmp, tmp2, '/');
2391: }
2392: } else {
2393: if (atyp > 1) {
2394: stcpy (tmp2, EUR2WHR[atyp]);
2395: mul (tmp, tmp2);
2396: }
2397: if (btyp > 1) {
2398: stcpy (tmp2, EUR2WHR[btyp]);
2399: mul (a, tmp2);
2400: }
2401: atyp = btyp = 0;
2402: }
2403: } else if (btyp && typemmflag && (*a != '0' || op == '#')) {
2404: merr_raise (TYPEMISMATCH);
2405: return;
2406: }
2407: } else if (op != '#')
2408: atyp = 0;
2409: #endif /* EUR2DEM */
2410: if (tmp[0] == ZERO) {
2411: merr_raise (M9);
2412: break;
2413: }
2414: mdiv (a, tmp, op);
2415: goto plus02;
2416:
2417: case ' ':
2418: power (a, tmp);
2419: break; /* ' ' stands for power */
2420:
2421: case '>':
2422:
2423: #ifdef EUR2DEM
2424: if (atyp != btyp) {
2425: char tmp2[(STRLEN + 1)/*was 256*/];
2426:
2427: if ((atyp == 0) && (a[0] == '0'))
2428: atyp = btyp; /* zero is any currency */
2429: if ((btyp == 0) && (tmp[0] == '0'))
2430: btyp = atyp; /* zero is any currency */
2431: if (atyp && btyp) {
2432: if (atyp > 1) {
2433: stcpy (tmp2, EUR2WHR[atyp]);
2434: mul (tmp, tmp2);
2435: }
2436: if (btyp > 1) {
2437: stcpy (tmp2, EUR2WHR[btyp]);
2438: mul (a, tmp2);
2439: }
2440: cond_round (a, zprecise + 2);
2441: cond_round (tmp, zprecise + 2);
2442: } else if (atyp != btyp && typemmflag) {
2443: merr_raise (TYPEMISMATCH);
2444: return;
2445: }
2446: }
2447: #endif /* EUR2DEM */
2448: if (comp (tmp, a))
2449: *a = ONE;
2450: else
2451: *a = ZERO;
2452: if (op & 0200)
2453: toggle (*a); /* NOT_OPERAND */
2454: a[1] = EOL;
2455: break;
2456:
2457: case '<':
2458:
2459: #ifdef EUR2DEM
2460: if (atyp != btyp) {
2461: char tmp2[(STRLEN + 1)/*was 256*/];
2462:
2463: if ((atyp == 0) && (a[0] == '0'))
2464: atyp = btyp; /* zero is any currency */
2465: if ((btyp == 0) && (tmp[0] == '0'))
2466: btyp = atyp; /* zero is any currency */
2467: if (atyp && btyp) {
2468: if (atyp > 1) {
2469: stcpy (tmp2, EUR2WHR[atyp]);
2470: mul (tmp, tmp2);
2471: }
2472: if (btyp > 1) {
2473: stcpy (tmp2, EUR2WHR[btyp]);
2474: mul (a, tmp2);
2475: }
2476: cond_round (a, zprecise + 2);
2477: cond_round (tmp, zprecise + 2);
2478: } else if (atyp != btyp && typemmflag) {
2479: merr_raise (TYPEMISMATCH);
2480: return;
2481: }
2482: }
2483: #endif /* EUR2DEM */
2484: if (comp (a, tmp))
2485: *a = ONE;
2486: else
2487: *a = ZERO;
2488: if (op & 0200)
2489: toggle (*a); /* NOT_OPERAND */
2490: a[1] = EOL;
2491: break;
2492:
2493: case '&':
2494:
2495: if (tvexpr (a)) {
2496: tvexpr (tmp);
2497: *a = *tmp;
2498: }
2499: if (op & 0200)
2500: toggle (*a); /* NOT_OPERAND */
2501: a[1] = EOL;
2502: break;
2503:
2504: case '!':
2505:
2506: if (tvexpr (a) == FALSE && tvexpr (tmp))
2507: *a = ONE;
2508: if (op & 0200)
2509: toggle (*a); /* NOT_OPERAND */
2510: a[1] = EOL;
2511: break;
2512:
2513: default:
2514: merr_raise (ASSIGNER);
2515:
2516: }
2517: return;
2518: } /* end m_op */
2519: /******************************************************************************/
2520: /* rounding */
2521: /* 'a' is assumed to be a 'canonic' numeric string */
2522: /* it is rounded to 'digits' fractional digits */
2523: void mround (char *a, int digits)
2524: {
2525: int ch,
2526: i,
2527: pointpos,
2528: lena;
2529:
2530: pointpos = -1;
2531: i = 0;
2532: i = 0;
2533: while (a[i] != EOL) {
2534: if (a[i] == POINT)
2535: pointpos = i;
2536: i++;
2537: }
2538: lena = i;
2539: if (pointpos < 0)
2540: pointpos = i;
2541: if ((pointpos + digits + 1) >= i)
2542: return; /* nothing to round */
2543: i = pointpos + digits + 1;
2544: if (a[i] < FIVE) {
2545: a[i] = EOL;
2546: while (a[--i] == ZERO)
2547: a[i] = EOL;
2548: if (a[i] == POINT) {
2549: a[i] = EOL;
2550: if (i == 0 || (i == 1 && a[0] == MINUS))
2551: a[0] = ZERO;
2552: }
2553: return;
2554: }
2555: for (;;)
2556: {
2557: if (i >= pointpos)
2558: a[i] = EOL;
2559: else
2560: a[i] = ZERO;
2561: if (--i < (a[0] == MINUS)) {
2562: for (i = lena; i >= 0; i--)
2563: a[i + 1] = a[i];
2564: a[a[0] == '-'] = ONE;
2565: break;
2566: }
2567: if ((ch = a[i]) == POINT)
2568: continue;
2569: if (a[i] < NINE && ch >= ZERO) {
2570: a[i] = ++ch;
2571: break;
2572: }
2573: }
2574: return;
2575: } /* end mround */
2576:
2577: /* End of $Source: /home/cvsroot/freem/src/operator.c,v $ */
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to operator.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem / src