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