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