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