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