modules/evalparse.c

   1 /* GNU m4 -- A simple macro processor
   2    Copyright (C) 1989, 1990, 1991, 1992, 1993, 1994, 2001, 2006, 2007,
   3    2008, 2009 Free Software Foundation, Inc.
   4
   5    This file is part of GNU M4.
   6
   7    GNU M4 is free software: you can redistribute it and/or modify
   8    it under the terms of the GNU General Public License as published by
   9    the Free Software Foundation, either version 3 of the License, or
  10    (at your option) any later version.
  11
  12    GNU M4 is distributed in the hope that it will be useful,
  13    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15    GNU General Public License for more details.
  16
  17    You should have received a copy of the GNU General Public License
  18    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19 */
  20
  21 /* This file contains the functions to evaluate integer expressions
  22    for the "eval" and "evalmp" builtins.  It is a little, fairly
  23    self-contained module, with its own scanner, and a recursive descent
  24    parser.
  25
  26    It has been carefully factored for use from the GMP module builtin,
  27    mpeval: any actual operation performed on numbers is abstracted by
  28    a set of macro definitions.  For plain `eval', `number' is some
  29    long int type, and `numb_*' manipulate those long ints.  When
  30    using GMP, `number' is typedef'd to `mpq_t' (the arbritrary
  31    precision fractional numbers type of GMP), and `numb_*' are mapped
  32    to GMP functions.
  33
  34    There is only one entry point, `m4_evaluate', a single function for
  35    both `eval' and `mpeval', but which is redefined appropriately when
  36    this file is #included into its clients.  */
  37
  38 typedef enum eval_token
  39   {
  40     ERROR, BADOP,
  41     PLUS, MINUS,
  42     EXPONENT,
  43     TIMES, DIVIDE, MODULO, RATIO,
  44     EQ, NOTEQ, GT, GTEQ, LS, LSEQ,
  45     LSHIFT, RSHIFT, URSHIFT,
  46     LNOT, LAND, LOR,
  47     NOT, AND, OR, XOR,
  48     LEFTP, RIGHTP,
  49     QUESTION, COLON, COMMA,
  50     NUMBER, EOTEXT
  51   }
  52 eval_token;
  53
  54 /* Error types.  */
  55
  56 typedef enum eval_error
  57   {
  58     NO_ERROR,
  59     DIVIDE_ZERO,
  60     MODULO_ZERO,
  61     NEGATIVE_EXPONENT,
  62     /* All errors prior to SYNTAX_ERROR can be ignored in a dead
  63        branch of && and ||.  All errors after are just more details
  64        about a syntax error.  */
  65     SYNTAX_ERROR,
  66     MISSING_RIGHT,
  67     MISSING_COLON,
  68     UNKNOWN_INPUT,
  69     EXCESS_INPUT,
  70     INVALID_OPERATOR
  71   }
  72 eval_error;
  73
  74 static eval_error comma_term            (m4 *, eval_token, number *);
  75 static eval_error condition_term        (m4 *, eval_token, number *);
  76 static eval_error logical_or_term       (m4 *, eval_token, number *);
  77 static eval_error logical_and_term      (m4 *, eval_token, number *);
  78 static eval_error or_term               (m4 *, eval_token, number *);
  79 static eval_error xor_term              (m4 *, eval_token, number *);
  80 static eval_error and_term              (m4 *, eval_token, number *);
  81 static eval_error equality_term         (m4 *, eval_token, number *);
  82 static eval_error cmp_term              (m4 *, eval_token, number *);
  83 static eval_error shift_term            (m4 *, eval_token, number *);
  84 static eval_error add_term              (m4 *, eval_token, number *);
  85 static eval_error mult_term             (m4 *, eval_token, number *);
  86 static eval_error exp_term              (m4 *, eval_token, number *);
  87 static eval_error unary_term            (m4 *, eval_token, number *);
  88 static eval_error simple_term           (m4 *, eval_token, number *);
  89 static eval_error numb_pow              (number *, number *);
  90
  91
  92 \f
  93 /* --- LEXICAL FUNCTIONS --- */
  94
  95 /* Pointer to next character of input text.  */
  96 static const char *eval_text;
  97
  98 /* Value of eval_text, from before last call of eval_lex ().  This is so we
  99    can back up, if we have read too much.  */
 100 static const char *last_text;
 101
 102 /* Detect when to end parsing.  */
 103 static const char *end_text;
 104
 105 /* Prime the lexer at the start of TEXT, with length LEN.  */
 106 static void
 107 eval_init_lex (const char *text, size_t len)
 108 {
 109   eval_text = text;
 110   end_text = text + len;
 111   last_text = NULL;
 112 }
 113
 114 static void
 115 eval_undo (void)
 116 {
 117   eval_text = last_text;
 118 }
 119
 120 /* VAL is numerical value, if any.  Recognize C assignment operators,
 121    even though we cannot support them, to issue better error
 122    messages.  */
 123
 124 static eval_token
 125 eval_lex (number *val)
 126 {
 127   while (eval_text != end_text && isspace (to_uchar (*eval_text)))
 128     eval_text++;
 129
 130   last_text = eval_text;
 131
 132   if (eval_text == end_text)
 133     return EOTEXT;
 134
 135   if (isdigit (to_uchar (*eval_text)))
 136     {
 137       int base, digit;
 138
 139       if (*eval_text == '0')
 140         {
 141           eval_text++;
 142           switch (*eval_text)
 143             {
 144             case 'x':
 145             case 'X':
 146               base = 16;
 147               eval_text++;
 148               break;
 149
 150             case 'b':
 151             case 'B':
 152               base = 2;
 153               eval_text++;
 154               break;
 155
 156             case 'r':
 157             case 'R':
 158               base = 0;
 159               eval_text++;
 160               while (isdigit (to_uchar (*eval_text)) && base <= 36)
 161                 base = 10 * base + *eval_text++ - '0';
 162               if (base == 0 || base > 36 || *eval_text != ':')
 163                 return ERROR;
 164               eval_text++;
 165               break;
 166
 167             default:
 168               base = 8;
 169             }
 170         }
 171       else
 172         base = 10;
 173
 174       numb_set_si (val, 0);
 175       for (; *eval_text; eval_text++)
 176         {
 177           if (isdigit (to_uchar (*eval_text)))
 178             digit = *eval_text - '0';
 179           else if (islower (to_uchar (*eval_text)))
 180             digit = *eval_text - 'a' + 10;
 181           else if (isupper (to_uchar (*eval_text)))
 182             digit = *eval_text - 'A' + 10;
 183           else
 184             break;
 185
 186           if (base == 1)
 187             {
 188               if (digit == 1)
 189                 numb_incr (*val);
 190               else if (digit == 0 && numb_zerop (*val))
 191                 continue;
 192               else
 193                 break;
 194             }
 195           else if (digit >= base)
 196             break;
 197           else
 198             {
 199               number xbase;
 200               number xdigit;
 201
 202               /* (*val) = (*val) * base; */
 203               numb_init (xbase);
 204               numb_set_si (&xbase, base);
 205               numb_times (*val, xbase);
 206               numb_fini (xbase);
 207               /* (*val) = (*val) + digit; */
 208               numb_init (xdigit);
 209               numb_set_si (&xdigit, digit);
 210               numb_plus (*val, xdigit);
 211               numb_fini (xdigit);
 212             }
 213         }
 214       return NUMBER;
 215     }
 216
 217   switch (*eval_text++)
 218     {
 219     case '+':
 220       if (*eval_text == '+' || *eval_text == '=')
 221         return BADOP;
 222       return PLUS;
 223     case '-':
 224       if (*eval_text == '-' || *eval_text == '=')
 225         return BADOP;
 226       return MINUS;
 227     case '*':
 228       if (*eval_text == '*')
 229         {
 230           eval_text++;
 231           return EXPONENT;
 232         }
 233       else if (*eval_text == '=')
 234         return BADOP;
 235       return TIMES;
 236     case '/':
 237       if (*eval_text == '=')
 238         return BADOP;
 239       return DIVIDE;
 240     case '%':
 241       if (*eval_text == '=')
 242         return BADOP;
 243       return MODULO;
 244     case '\\':
 245       return RATIO;
 246     case '=':
 247       if (*eval_text == '=')
 248         {
 249           eval_text++;
 250           return EQ;
 251         }
 252       return BADOP;
 253     case '!':
 254       if (*eval_text == '=')
 255         {
 256           eval_text++;
 257           return NOTEQ;
 258         }
 259       return LNOT;
 260     case '>':
 261       if (*eval_text == '=')
 262         {
 263           eval_text++;
 264           return GTEQ;
 265         }
 266       else if (*eval_text == '>')
 267         {
 268           eval_text++;
 269           if (*eval_text == '=')
 270             return BADOP;
 271           else if (*eval_text == '>')
 272             {
 273               eval_text++;
 274               return URSHIFT;
 275             }
 276           return RSHIFT;
 277         }
 278       else
 279         return GT;
 280     case '<':
 281       if (*eval_text == '=')
 282         {
 283           eval_text++;
 284           return LSEQ;
 285         }
 286       else if (*eval_text == '<')
 287         {
 288           if (*++eval_text == '=')
 289             return BADOP;
 290           return LSHIFT;
 291         }
 292       else
 293         return LS;
 294     case '^':
 295       if (*eval_text == '=')
 296         return BADOP;
 297       return XOR;
 298     case '~':
 299       return NOT;
 300     case '&':
 301       if (*eval_text == '&')
 302         {
 303           eval_text++;
 304           return LAND;
 305         }
 306       else if (*eval_text == '=')
 307         return BADOP;
 308       return AND;
 309     case '|':
 310       if (*eval_text == '|')
 311         {
 312           eval_text++;
 313           return LOR;
 314         }
 315       else if (*eval_text == '=')
 316         return BADOP;
 317       return OR;
 318     case '(':
 319       return LEFTP;
 320     case ')':
 321       return RIGHTP;
 322     case '?':
 323       return QUESTION;
 324     case ':':
 325       return COLON;
 326     case ',':
 327       return COMMA;
 328     default:
 329       return ERROR;
 330     }
 331 }
 332
 333 /* Recursive descent parser.  */
 334 static eval_error
 335 comma_term (m4 *context, eval_token et, number *v1)
 336 {
 337   number v2;
 338   eval_error er;
 339
 340   if ((er = condition_term (context, et, v1)) != NO_ERROR)
 341     return er;
 342
 343   numb_init (v2);
 344   while ((et = eval_lex (&v2)) == COMMA)
 345     {
 346       et = eval_lex (&v2);
 347       if (et == ERROR)
 348         return UNKNOWN_INPUT;
 349
 350       if ((er = condition_term (context, et, &v2)) != NO_ERROR)
 351         return er;
 352       numb_set (*v1, v2);
 353     }
 354   numb_fini (v2);
 355   if (et == ERROR)
 356     return UNKNOWN_INPUT;
 357
 358   eval_undo ();
 359   return NO_ERROR;
 360 }
 361
 362 static eval_error
 363 condition_term (m4 *context, eval_token et, number *v1)
 364 {
 365   number v2;
 366   number v3;
 367   eval_error er;
 368
 369   if ((er = logical_or_term (context, et, v1)) != NO_ERROR)
 370     return er;
 371
 372   numb_init (v2);
 373   numb_init (v3);
 374   if ((et = eval_lex (&v2)) == QUESTION)
 375     {
 376       et = eval_lex (&v2);
 377       if (et == ERROR)
 378         return UNKNOWN_INPUT;
 379
 380       /* Implement short-circuiting of valid syntax.  */
 381       er = comma_term (context, et, &v2);
 382       if (er != NO_ERROR
 383           && !(numb_zerop (*v1) && er < SYNTAX_ERROR))
 384         return er;
 385
 386       et = eval_lex (&v3);
 387       if (et == ERROR)
 388         return UNKNOWN_INPUT;
 389       if (et != COLON)
 390         return MISSING_COLON;
 391
 392       et = eval_lex (&v3);
 393       if (et == ERROR)
 394         return UNKNOWN_INPUT;
 395
 396       er = condition_term (context, et, &v3);
 397       if (er != NO_ERROR
 398           && !(! numb_zerop (*v1) && er < SYNTAX_ERROR))
 399         return er;
 400
 401       numb_set (*v1, ! numb_zerop (*v1) ? v2 : v3);
 402     }
 403   numb_fini (v2);
 404   numb_fini (v3);
 405   if (et == ERROR)
 406     return UNKNOWN_INPUT;
 407
 408   eval_undo ();
 409   return NO_ERROR;
 410 }
 411
 412 static eval_error
 413 logical_or_term (m4 *context, eval_token et, number *v1)
 414 {
 415   number v2;
 416   eval_error er;
 417
 418   if ((er = logical_and_term (context, et, v1)) != NO_ERROR)
 419     return er;
 420
 421   numb_init (v2);
 422   while ((et = eval_lex (&v2)) == LOR)
 423     {
 424       et = eval_lex (&v2);
 425       if (et == ERROR)
 426         return UNKNOWN_INPUT;
 427
 428       /* Implement short-circuiting of valid syntax.  */
 429       er = logical_and_term (context, et, &v2);
 430       if (er == NO_ERROR)
 431         numb_lior (*v1, v2);
 432       else if (! numb_zerop (*v1) && er < SYNTAX_ERROR)
 433         numb_set (*v1, numb_ONE);
 434       else
 435         return er;
 436     }
 437   numb_fini (v2);
 438   if (et == ERROR)
 439     return UNKNOWN_INPUT;
 440
 441   eval_undo ();
 442   return NO_ERROR;
 443 }
 444
 445 static eval_error
 446 logical_and_term (m4 *context, eval_token et, number *v1)
 447 {
 448   number v2;
 449   eval_error er;
 450
 451   if ((er = or_term (context, et, v1)) != NO_ERROR)
 452     return er;
 453
 454   numb_init (v2);
 455   while ((et = eval_lex (&v2)) == LAND)
 456     {
 457       et = eval_lex (&v2);
 458       if (et == ERROR)
 459         return UNKNOWN_INPUT;
 460
 461       /* Implement short-circuiting of valid syntax.  */
 462       er = or_term (context, et, &v2);
 463       if (er == NO_ERROR)
 464         numb_land (*v1, v2);
 465       else if (numb_zerop (*v1) && er < SYNTAX_ERROR)
 466         numb_set (*v1, numb_ZERO);
 467       else
 468         return er;
 469     }
 470   numb_fini (v2);
 471   if (et == ERROR)
 472     return UNKNOWN_INPUT;
 473
 474   eval_undo ();
 475   return NO_ERROR;
 476 }
 477
 478 static eval_error
 479 or_term (m4 *context, eval_token et, number *v1)
 480 {
 481   number v2;
 482   eval_error er;
 483
 484   if ((er = xor_term (context, et, v1)) != NO_ERROR)
 485     return er;
 486
 487   numb_init (v2);
 488   while ((et = eval_lex (&v2)) == OR)
 489     {
 490       et = eval_lex (&v2);
 491       if (et == ERROR)
 492         return UNKNOWN_INPUT;
 493
 494       if ((er = xor_term (context, et, &v2)) != NO_ERROR)
 495         return er;
 496
 497       numb_ior (context, v1, &v2);
 498     }
 499   numb_fini (v2);
 500   if (et == ERROR)
 501     return UNKNOWN_INPUT;
 502
 503   eval_undo ();
 504   return NO_ERROR;
 505 }
 506
 507 static eval_error
 508 xor_term (m4 *context, eval_token et, number *v1)
 509 {
 510   number v2;
 511   eval_error er;
 512
 513   if ((er = and_term (context, et, v1)) != NO_ERROR)
 514     return er;
 515
 516   numb_init (v2);
 517   while ((et = eval_lex (&v2)) == XOR)
 518     {
 519       et = eval_lex (&v2);
 520       if (et == ERROR)
 521         return UNKNOWN_INPUT;
 522
 523       if ((er = and_term (context, et, &v2)) != NO_ERROR)
 524         return er;
 525
 526       numb_eor (context, v1, &v2);
 527     }
 528   numb_fini (v2);
 529   if (et == ERROR)
 530     return UNKNOWN_INPUT;
 531
 532   eval_undo ();
 533   return NO_ERROR;
 534 }
 535
 536 static eval_error
 537 and_term (m4 *context, eval_token et, number *v1)
 538 {
 539   number v2;
 540   eval_error er;
 541
 542   if ((er = equality_term (context, et, v1)) != NO_ERROR)
 543     return er;
 544
 545   numb_init (v2);
 546   while ((et = eval_lex (&v2)) == AND)
 547     {
 548       et = eval_lex (&v2);
 549       if (et == ERROR)
 550         return UNKNOWN_INPUT;
 551
 552       if ((er = equality_term (context, et, &v2)) != NO_ERROR)
 553         return er;
 554
 555       numb_and (context, v1, &v2);
 556     }
 557   numb_fini (v2);
 558   if (et == ERROR)
 559     return UNKNOWN_INPUT;
 560
 561   eval_undo ();
 562   return NO_ERROR;
 563 }
 564
 565 static eval_error
 566 equality_term (m4 *context, eval_token et, number *v1)
 567 {
 568   eval_token op;
 569   number v2;
 570   eval_error er;
 571
 572   if ((er = cmp_term (context, et, v1)) != NO_ERROR)
 573     return er;
 574
 575   numb_init (v2);
 576   while ((op = eval_lex (&v2)) == EQ || op == NOTEQ)
 577     {
 578       et = eval_lex (&v2);
 579       if (et == ERROR)
 580         return UNKNOWN_INPUT;
 581
 582       if ((er = cmp_term (context, et, &v2)) != NO_ERROR)
 583         return er;
 584
 585       if (op == EQ)
 586         numb_eq (*v1, v2);
 587       else
 588         numb_ne (*v1, v2);
 589     }
 590   numb_fini (v2);
 591   if (op == ERROR)
 592     return UNKNOWN_INPUT;
 593
 594   eval_undo ();
 595   return NO_ERROR;
 596 }
 597
 598 static eval_error
 599 cmp_term (m4 *context, eval_token et, number *v1)
 600 {
 601   eval_token op;
 602   number v2;
 603   eval_error er;
 604
 605   if ((er = shift_term (context, et, v1)) != NO_ERROR)
 606     return er;
 607
 608   numb_init (v2);
 609   while ((op = eval_lex (&v2)) == GT || op == GTEQ
 610          || op == LS || op == LSEQ)
 611     {
 612
 613       et = eval_lex (&v2);
 614       if (et == ERROR)
 615         return UNKNOWN_INPUT;
 616
 617       if ((er = shift_term (context, et, &v2)) != NO_ERROR)
 618         return er;
 619
 620       switch (op)
 621         {
 622         case GT:
 623           numb_gt (*v1, v2);
 624           break;
 625
 626         case GTEQ:
 627           numb_ge (*v1, v2);
 628           break;
 629
 630         case LS:
 631           numb_lt (*v1, v2);
 632           break;
 633
 634         case LSEQ:
 635           numb_le (*v1, v2);
 636           break;
 637
 638         default:
 639           assert (!"INTERNAL ERROR: bad comparison operator in cmp_term ()");
 640           abort ();
 641         }
 642     }
 643   numb_fini (v2);
 644   if (op == ERROR)
 645     return UNKNOWN_INPUT;
 646
 647   eval_undo ();
 648   return NO_ERROR;
 649 }
 650
 651 static eval_error
 652 shift_term (m4 *context, eval_token et, number *v1)
 653 {
 654   eval_token op;
 655   number v2;
 656   eval_error er;
 657
 658   if ((er = add_term (context, et, v1)) != NO_ERROR)
 659     return er;
 660
 661   numb_init (v2);
 662   while ((op = eval_lex (&v2)) == LSHIFT || op == RSHIFT || op == URSHIFT)
 663     {
 664
 665       et = eval_lex (&v2);
 666       if (et == ERROR)
 667         return UNKNOWN_INPUT;
 668
 669       if ((er = add_term (context, et, &v2)) != NO_ERROR)
 670         return er;
 671
 672       switch (op)
 673         {
 674         case LSHIFT:
 675           numb_lshift (context, v1, &v2);
 676           break;
 677
 678         case RSHIFT:
 679           numb_rshift (context, v1, &v2);
 680           break;
 681
 682         case URSHIFT:
 683           numb_urshift (context, v1, &v2);
 684           break;
 685
 686         default:
 687           assert (!"INTERNAL ERROR: bad shift operator in shift_term ()");
 688           abort ();
 689         }
 690     }
 691   numb_fini (v2);
 692   if (op == ERROR)
 693     return UNKNOWN_INPUT;
 694
 695   eval_undo ();
 696   return NO_ERROR;
 697 }
 698
 699 static eval_error
 700 add_term (m4 *context, eval_token et, number *v1)
 701 {
 702   eval_token op;
 703   number v2;
 704   eval_error er;
 705
 706   if ((er = mult_term (context, et, v1)) != NO_ERROR)
 707     return er;
 708
 709   numb_init (v2);
 710   while ((op = eval_lex (&v2)) == PLUS || op == MINUS)
 711     {
 712       et = eval_lex (&v2);
 713       if (et == ERROR)
 714         return UNKNOWN_INPUT;
 715
 716       if ((er = mult_term (context, et, &v2)) != NO_ERROR)
 717         return er;
 718
 719       if (op == PLUS)
 720         numb_plus (*v1, v2);
 721       else
 722         numb_minus (*v1, v2);
 723     }
 724   numb_fini (v2);
 725   if (op == ERROR)
 726     return UNKNOWN_INPUT;
 727
 728   eval_undo ();
 729   return NO_ERROR;
 730 }
 731
 732 static eval_error
 733 mult_term (m4 *context, eval_token et, number *v1)
 734 {
 735   eval_token op;
 736   number v2;
 737   eval_error er;
 738
 739   if ((er = exp_term (context, et, v1)) != NO_ERROR)
 740     return er;
 741
 742   numb_init (v2);
 743   while (op = eval_lex (&v2),
 744          op == TIMES
 745          || op == DIVIDE
 746          || op == MODULO
 747          || op == RATIO)
 748     {
 749       et = eval_lex (&v2);
 750       if (et == ERROR)
 751         return UNKNOWN_INPUT;
 752
 753       if ((er = exp_term (context, et, &v2)) != NO_ERROR)
 754         return er;
 755
 756       switch (op)
 757         {
 758         case TIMES:
 759           numb_times (*v1, v2);
 760           break;
 761
 762         case DIVIDE:
 763           if (numb_zerop (v2))
 764             return DIVIDE_ZERO;
 765           else
 766             numb_divide(v1, &v2);
 767           break;
 768
 769         case RATIO:
 770           if (numb_zerop (v2))
 771             return DIVIDE_ZERO;
 772           else
 773             numb_ratio (*v1, v2);
 774           break;
 775
 776         case MODULO:
 777           if (numb_zerop (v2))
 778             return MODULO_ZERO;
 779           else
 780             numb_modulo (context, v1, &v2);
 781           break;
 782
 783         default:
 784           assert (!"INTERNAL ERROR: bad operator in mult_term ()");
 785           abort ();
 786         }
 787     }
 788   numb_fini (v2);
 789   if (op == ERROR)
 790     return UNKNOWN_INPUT;
 791
 792   eval_undo ();
 793   return NO_ERROR;
 794 }
 795
 796 static eval_error
 797 exp_term (m4 *context, eval_token et, number *v1)
 798 {
 799   number v2;
 800   eval_error er;
 801
 802   if ((er = unary_term (context, et, v1)) != NO_ERROR)
 803     return er;
 804
 805   numb_init (v2);
 806   while ((et = eval_lex (&v2)) == EXPONENT)
 807     {
 808       et = eval_lex (&v2);
 809       if (et == ERROR)
 810         return UNKNOWN_INPUT;
 811
 812       if ((er = exp_term (context, et, &v2)) != NO_ERROR)
 813         return er;
 814
 815       if ((er = numb_pow (v1, &v2)) != NO_ERROR)
 816         return er;
 817     }
 818   numb_fini (v2);
 819   if (et == ERROR)
 820     return UNKNOWN_INPUT;
 821
 822   eval_undo ();
 823   return NO_ERROR;
 824 }
 825
 826 static eval_error
 827 unary_term (m4 *context, eval_token et, number *v1)
 828 {
 829   eval_token et2 = et;
 830   eval_error er;
 831
 832   if (et == PLUS || et == MINUS || et == NOT || et == LNOT)
 833     {
 834       et2 = eval_lex (v1);
 835       if (et2 == ERROR)
 836         return UNKNOWN_INPUT;
 837
 838       if ((er = unary_term (context, et2, v1)) != NO_ERROR)
 839         return er;
 840
 841       if (et == MINUS)
 842         numb_negate(*v1);
 843       else if (et == NOT)
 844         numb_not (context, v1);
 845       else if (et == LNOT)
 846         numb_lnot (*v1);
 847     }
 848   else if ((er = simple_term (context, et, v1)) != NO_ERROR)
 849     return er;
 850
 851   return NO_ERROR;
 852 }
 853
 854 static eval_error
 855 simple_term (m4 *context, eval_token et, number *v1)
 856 {
 857   number v2;
 858   eval_error er;
 859
 860   switch (et)
 861     {
 862     case LEFTP:
 863       et = eval_lex (v1);
 864       if (et == ERROR)
 865         return UNKNOWN_INPUT;
 866
 867       if ((er = comma_term (context, et, v1)) != NO_ERROR)
 868         return er;
 869
 870       et = eval_lex (&v2);
 871       if (et == ERROR)
 872         return UNKNOWN_INPUT;
 873
 874       if (et != RIGHTP)
 875         return MISSING_RIGHT;
 876
 877       break;
 878
 879     case NUMBER:
 880       break;
 881
 882     case BADOP:
 883       return INVALID_OPERATOR;
 884
 885     default:
 886       return SYNTAX_ERROR;
 887     }
 888   return NO_ERROR;
 889 }
 890
 891 /* Main entry point, called from "eval" and "mpeval" builtins.  */
 892 void
 893 m4_evaluate (m4 *context, m4_obstack *obs, size_t argc, m4_macro_args *argv)
 894 {
 895   const m4_call_info *me = m4_arg_info (argv);
 896   const char *  str     = M4ARG (1);
 897   int           radix   = 10;
 898   int           min     = 1;
 899   number        val;
 900   eval_token    et;
 901   eval_error    err     = NO_ERROR;
 902
 903   if (!m4_arg_empty (argv, 2)
 904       && !m4_numeric_arg (context, me, M4ARG (2), M4ARGLEN (2), &radix))
 905     return;
 906
 907   if (radix < 1 || radix > 36)
 908     {
 909       m4_warn (context, 0, me, _("radix out of range: %d"), radix);
 910       return;
 911     }
 912
 913   if (argc >= 4 && !m4_numeric_arg (context, me, M4ARG (3), M4ARGLEN (3),
 914                                     &min))
 915     return;
 916
 917   if (min < 0)
 918     {
 919       m4_warn (context, 0, me, _("negative width: %d"), min);
 920       return;
 921     }
 922
 923   numb_initialise ();
 924   eval_init_lex (str, M4ARGLEN (1));
 925
 926   numb_init (val);
 927   et = eval_lex (&val);
 928   if (et == EOTEXT)
 929     {
 930       m4_warn (context, 0, me, _("empty string treated as 0"));
 931       numb_set (val, numb_ZERO);
 932     }
 933   else
 934     err = comma_term (context, et, &val);
 935
 936   if (err == NO_ERROR && *eval_text != '\0')
 937     {
 938       if (eval_lex (&val) == BADOP)
 939         err = INVALID_OPERATOR;
 940       else
 941         err = EXCESS_INPUT;
 942     }
 943
 944   if (err != NO_ERROR)
 945     str = quotearg_style_mem (locale_quoting_style, str, M4ARGLEN (1));
 946   switch (err)
 947     {
 948     case NO_ERROR:
 949       numb_obstack (obs, val, radix, min);
 950       break;
 951
 952     case MISSING_RIGHT:
 953       m4_warn (context, 0, me, _("missing right parenthesis: %s"), str);
 954       break;
 955
 956     case MISSING_COLON:
 957       m4_warn (context, 0, me, _("missing colon: %s"), str);
 958       break;
 959
 960     case SYNTAX_ERROR:
 961       m4_warn (context, 0, me, _("bad expression: %s"), str);
 962       break;
 963
 964     case UNKNOWN_INPUT:
 965       m4_warn (context, 0, me, _("bad input: %s"), str);
 966       break;
 967
 968     case EXCESS_INPUT:
 969       m4_warn (context, 0, me, _("excess input: %s"), str);
 970       break;
 971
 972     case INVALID_OPERATOR:
 973       m4_warn (context, 0, me, _("invalid operator: %s"), str);
 974       break;
 975
 976     case DIVIDE_ZERO:
 977       m4_warn (context, 0, me, _("divide by zero: %s"), str);
 978       break;
 979
 980     case MODULO_ZERO:
 981       m4_warn (context, 0, me, _("modulo by zero: %s"), str);
 982       break;
 983
 984     case NEGATIVE_EXPONENT:
 985       m4_warn (context, 0, me, _("negative exponent: %s"), str);
 986       break;
 987
 988     default:
 989       assert (!"INTERNAL ERROR: bad error code in evaluate ()");
 990       abort ();
 991     }
 992
 993   numb_fini (val);
 994 }
 995
 996 static eval_error
 997 numb_pow (number *x, number *y)
 998 {
 999   /* y should be integral */
1000
1001   number ans, yy;
1002
1003   numb_init (ans);
1004   numb_set_si (&ans, 1);
1005
1006   if (numb_zerop (*x) && numb_zerop (*y))
1007     return DIVIDE_ZERO;
1008
1009   numb_init (yy);
1010   numb_set (yy, *y);
1011
1012   if (numb_negativep (yy))
1013     {
1014       numb_negate (yy);
1015       numb_invert (*x);
1016     }
1017
1018   while (numb_positivep (yy))
1019     {
1020       numb_times (ans, *x);
1021       numb_decr (yy);
1022     }
1023   numb_set (*x, ans);
1024
1025   numb_fini (ans);
1026   numb_fini (yy);
1027   return NO_ERROR;
1028 }