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