modules/evalparse.c

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