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