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