src/lexer.c

   1 /* PSPP - computes sample statistics.
   2    Copyright (C) 1997-9, 2000 Free Software Foundation, Inc.
   3    Written by Ben Pfaff <blp@gnu.org>.
   4
   5    This program is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU General Public License as
   7    published by the Free Software Foundation; either version 2 of the
   8    License, or (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful, but
  11    WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13    General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  18    02110-1301, USA. */
  19
  20 #include <config.h>
  21 #include "lexer.h"
  22 #include "error.h"
  23 #include <ctype.h>
  24 #include <errno.h>
  25 #include <limits.h>
  26 #include <math.h>
  27 #include <stdarg.h>
  28 #include <stdlib.h>
  29 #include "alloc.h"
  30 #include "command.h"
  31 #include "error.h"
  32 #include "getline.h"
  33 #include "magic.h"
  34 #include "settings.h"
  35 #include "str.h"
  36
  37 /*
  38 #define DUMP_TOKENS 1
  39 */
  40
  41 \f
  42 /* Global variables. */
  43
  44 /* Current token. */
  45 int token;
  46
  47 /* T_POS_NUM, T_NEG_NUM: the token's value. */
  48 double tokval;
  49
  50 /* T_ID: the identifier. */
  51 char tokid[LONG_NAME_LEN + 1];
  52
  53 /* T_ID, T_STRING: token string value.
  54    For T_ID, this is not truncated as is tokid. */
  55 struct string tokstr;
  56 \f
  57 /* Static variables. */
  58
  59 /* Table of keywords. */
  60 static const char *keywords[T_N_KEYWORDS + 1] =
  61   {
  62     "AND", "OR", "NOT",
  63     "EQ", "GE", "GT", "LE", "LT", "NE",
  64     "ALL", "BY", "TO", "WITH",
  65     NULL,
  66   };
  67
  68 /* Pointer to next token in getl_buf. */
  69 static char *prog;
  70
  71 /* Nonzero only if this line ends with a terminal dot. */
  72 static int dot;
  73
  74 /* Nonzero only if the last token returned was T_STOP. */
  75 static int eof;
  76
  77 /* If nonzero, next token returned by lex_get().
  78    Used only in exceptional circumstances. */
  79 static int put_token;
  80 static struct string put_tokstr;
  81 static double put_tokval;
  82
  83 static void unexpected_eof (void);
  84 static void convert_numeric_string_to_char_string (int type);
  85 static int parse_string (int type);
  86
  87 #if DUMP_TOKENS
  88 static void dump_token (void);
  89 #endif
  90 \f
  91 /* Initialization. */
  92
  93 /* Initializes the lexer. */
  94 void
  95 lex_init (void)
  96 {
  97   ds_init (&put_tokstr, 64);
  98   if (!lex_get_line ())
  99     unexpected_eof ();
 100 }
 101
 102 void
 103 lex_done (void)
 104 {
 105   ds_destroy(&put_tokstr);
 106 }
 107
 108 \f
 109 /* Common functions. */
 110
 111 /* Copies put_token, put_tokstr, put_tokval into token, tokstr,
 112    tokval, respectively, and sets tokid appropriately. */
 113 static void
 114 restore_token (void)
 115 {
 116   assert (put_token != 0);
 117   token = put_token;
 118   ds_replace (&tokstr, ds_c_str (&put_tokstr));
 119   str_copy_trunc (tokid, sizeof tokid, ds_c_str (&tokstr));
 120   tokval = put_tokval;
 121   put_token = 0;
 122 }
 123
 124 /* Copies token, tokstr, tokval into put_token, put_tokstr,
 125    put_tokval respectively. */
 126 static void
 127 save_token (void)
 128 {
 129   put_token = token;
 130   ds_replace (&put_tokstr, ds_c_str (&tokstr));
 131   put_tokval = tokval;
 132 }
 133
 134 /* Parses a single token, setting appropriate global variables to
 135    indicate the token's attributes. */
 136 void
 137 lex_get (void)
 138 {
 139   /* If a token was pushed ahead, return it. */
 140   if (put_token)
 141     {
 142       restore_token ();
 143 #if DUMP_TOKENS
 144       dump_token ();
 145 #endif
 146       return;
 147     }
 148
 149   /* Find a token. */
 150   for (;;)
 151     {
 152       char *cp;
 153
 154       /* Skip whitespace. */
 155       if (eof)
 156         unexpected_eof ();
 157
 158       for (;;)
 159         {
 160           while (isspace ((unsigned char) *prog))
 161             prog++;
 162           if (*prog)
 163             break;
 164
 165           if (dot)
 166             {
 167               dot = 0;
 168               token = '.';
 169 #if DUMP_TOKENS
 170               dump_token ();
 171 #endif
 172               return;
 173             }
 174           else if (!lex_get_line ())
 175             {
 176               eof = 1;
 177               token = T_STOP;
 178 #if DUMP_TOKENS
 179               dump_token ();
 180 #endif
 181               return;
 182             }
 183
 184           if (put_token)
 185             {
 186               restore_token ();
 187 #if DUMP_TOKENS
 188               dump_token ();
 189 #endif
 190               return;
 191             }
 192         }
 193
 194
 195       /* Actually parse the token. */
 196       cp = prog;
 197       ds_clear (&tokstr);
 198
 199       switch (*prog)
 200         {
 201         case '-': case '.':
 202         case '0': case '1': case '2': case '3': case '4':
 203         case '5': case '6': case '7': case '8': case '9':
 204           {
 205             char *tail;
 206
 207             /* `-' can introduce a negative number, or it can be a
 208                token by itself.  If it is not followed by a digit or a
 209                decimal point, it is definitely not a number.
 210                Otherwise, it might be either, but most of the time we
 211                want it as a number.  When the syntax calls for a `-'
 212                token, lex_negative_to_dash() must be used to break
 213                negative numbers into two tokens. */
 214             if (*cp == '-')
 215               {
 216                 ds_putc (&tokstr, *prog++);
 217                 while (isspace ((unsigned char) *prog))
 218                   prog++;
 219
 220                 if (!isdigit ((unsigned char) *prog) && *prog != '.')
 221                   {
 222                     token = '-';
 223                     break;
 224                   }
 225                 token = T_NEG_NUM;
 226               }
 227             else
 228               token = T_POS_NUM;
 229
 230             /* Parse the number, copying it into tokstr. */
 231             while (isdigit ((unsigned char) *prog))
 232               ds_putc (&tokstr, *prog++);
 233             if (*prog == '.')
 234               {
 235                 ds_putc (&tokstr, *prog++);
 236                 while (isdigit ((unsigned char) *prog))
 237                   ds_putc (&tokstr, *prog++);
 238               }
 239             if (*prog == 'e' || *prog == 'E')
 240               {
 241                 ds_putc (&tokstr, *prog++);
 242                 if (*prog == '+' || *prog == '-')
 243                   ds_putc (&tokstr, *prog++);
 244                 while (isdigit ((unsigned char) *prog))
 245                   ds_putc (&tokstr, *prog++);
 246               }
 247
 248             /* Parse as floating point. */
 249             tokval = strtod (ds_c_str (&tokstr), &tail);
 250             if (*tail)
 251               {
 252                 msg (SE, _("%s does not form a valid number."),
 253                      ds_c_str (&tokstr));
 254                 tokval = 0.0;
 255
 256                 ds_clear (&tokstr);
 257                 ds_putc (&tokstr, '0');
 258               }
 259
 260             break;
 261           }
 262
 263         case '\'': case '"':
 264           token = parse_string (0);
 265           break;
 266
 267         case '(': case ')': case ',': case '=': case '+': case '/':
 268           token = *prog++;
 269           break;
 270
 271         case '*':
 272           if (*++prog == '*')
 273             {
 274               prog++;
 275               token = T_EXP;
 276             }
 277           else
 278             token = '*';
 279           break;
 280
 281         case '<':
 282           if (*++prog == '=')
 283             {
 284               prog++;
 285               token = T_LE;
 286             }
 287           else if (*prog == '>')
 288             {
 289               prog++;
 290               token = T_NE;
 291             }
 292           else
 293             token = T_LT;
 294           break;
 295
 296         case '>':
 297           if (*++prog == '=')
 298             {
 299               prog++;
 300               token = T_GE;
 301             }
 302           else
 303             token = T_GT;
 304           break;
 305
 306         case '~':
 307           if (*++prog == '=')
 308             {
 309               prog++;
 310               token = T_NE;
 311             }
 312           else
 313             token = T_NOT;
 314           break;
 315
 316         case '&':
 317           prog++;
 318           token = T_AND;
 319           break;
 320
 321         case '|':
 322           prog++;
 323           token = T_OR;
 324           break;
 325
 326         case 'a': case 'b': case 'c': case 'd': case 'e':
 327         case 'f': case 'g': case 'h': case 'i': case 'j':
 328         case 'k': case 'l': case 'm': case 'n': case 'o':
 329         case 'p': case 'q': case 'r': case 's': case 't':
 330         case 'u': case 'v': case 'w': case 'x': case 'y':
 331         case 'z':
 332         case 'A': case 'B': case 'C': case 'D': case 'E':
 333         case 'F': case 'G': case 'H': case 'I': case 'J':
 334         case 'K': case 'L': case 'M': case 'N': case 'O':
 335         case 'P': case 'Q': case 'R': case 'S': case 'T':
 336         case 'U': case 'V': case 'W': case 'X': case 'Y':
 337         case 'Z':
 338         case '#': case '$': case '@':
 339           /* Strings can be specified in binary, octal, or hex using
 340                this special syntax. */
 341           if (prog[1] == '\'' || prog[1] == '"')
 342             {
 343               static const char special[3] = "box";
 344               const char *p;
 345
 346               p = strchr (special, tolower ((unsigned char) *prog));
 347               if (p)
 348                 {
 349                   prog++;
 350                   token = parse_string (p - special + 1);
 351                   break;
 352                 }
 353             }
 354
 355           /* Copy id to tokstr. */
 356           ds_putc (&tokstr, *prog++);
 357           while (CHAR_IS_IDN (*prog))
 358             ds_putc (&tokstr, *prog++);
 359
 360           /* Copy tokstr to tokid, possibly truncating it.*/
 361           str_copy_trunc (tokid, sizeof tokid, ds_c_str (&tokstr));
 362
 363           /* Determine token type. */
 364           token = lex_id_to_token (ds_c_str (&tokstr), ds_length (&tokstr));
 365           break;
 366
 367         default:
 368           if (isgraph ((unsigned char) *prog))
 369             msg (SE, _("Bad character in input: `%c'."), *prog++);
 370           else
 371             msg (SE, _("Bad character in input: `\\%o'."), *prog++);
 372           continue;
 373         }
 374
 375       break;
 376     }
 377
 378 #if DUMP_TOKENS
 379   dump_token ();
 380 #endif
 381 }
 382
 383 /* Prints a syntax error message containing the current token and
 384    given message MESSAGE (if non-null). */
 385 void
 386 lex_error (const char *message, ...)
 387 {
 388   char *token_rep;
 389   char where[128];
 390
 391   token_rep = lex_token_representation ();
 392   if (token == T_STOP)
 393     strcpy (where, "end of file");
 394   else if (token == '.')
 395     strcpy (where, "end of command");
 396   else
 397     snprintf (where, sizeof where, "`%s'", token_rep);
 398   free (token_rep);
 399
 400   if (message)
 401     {
 402       char buf[1024];
 403       va_list args;
 404
 405       va_start (args, message);
 406       vsnprintf (buf, 1024, message, args);
 407       va_end (args);
 408
 409       msg (SE, _("Syntax error %s at %s."), buf, where);
 410     }
 411   else
 412     msg (SE, _("Syntax error at %s."), where);
 413 }
 414
 415 /* Checks that we're at end of command.
 416    If so, returns a successful command completion code.
 417    If not, flags a syntax error and returns an error command
 418    completion code. */
 419 int
 420 lex_end_of_command (void)
 421 {
 422   if (token != '.')
 423     {
 424       lex_error (_("expecting end of command"));
 425       return CMD_TRAILING_GARBAGE;
 426     }
 427   else
 428     return CMD_SUCCESS;
 429 }
 430 \f
 431 /* Token testing functions. */
 432
 433 /* Returns true if the current token is a number. */
 434 bool
 435 lex_is_number (void)
 436 {
 437   return token == T_POS_NUM || token == T_NEG_NUM;
 438 }
 439
 440 /* Returns the value of the current token, which must be a
 441    floating point number. */
 442 double
 443 lex_number (void)
 444 {
 445   assert (lex_is_number ());
 446   return tokval;
 447 }
 448
 449 /* Returns true iff the current token is an integer. */
 450 bool
 451 lex_is_integer (void)
 452 {
 453   return (lex_is_number ()
 454           && tokval != NOT_LONG
 455           && tokval >= LONG_MIN
 456           && tokval <= LONG_MAX
 457           && floor (tokval) == tokval);
 458 }
 459
 460 /* Returns the value of the current token, which must be an
 461    integer. */
 462 long
 463 lex_integer (void)
 464 {
 465   assert (lex_is_integer ());
 466   return tokval;
 467 }
 468 \f
 469 /* Token matching functions. */
 470
 471 /* If TOK is the current token, skips it and returns nonzero.
 472    Otherwise, returns zero. */
 473 int
 474 lex_match (int t)
 475 {
 476   if (token == t)
 477     {
 478       lex_get ();
 479       return 1;
 480     }
 481   else
 482     return 0;
 483 }
 484
 485 /* If the current token is the identifier S, skips it and returns
 486    nonzero.  The identifier may be abbreviated to its first three
 487    letters.
 488    Otherwise, returns zero. */
 489 int
 490 lex_match_id (const char *s)
 491 {
 492   if (token == T_ID && lex_id_match (s, tokid))
 493     {
 494       lex_get ();
 495       return 1;
 496     }
 497   else
 498     return 0;
 499 }
 500
 501 /* If the current token is integer N, skips it and returns nonzero.
 502    Otherwise, returns zero. */
 503 int
 504 lex_match_int (int x)
 505 {
 506   if (lex_is_integer () && lex_integer () == x)
 507     {
 508       lex_get ();
 509       return 1;
 510     }
 511   else
 512     return 0;
 513 }
 514 \f
 515 /* Forced matches. */
 516
 517 /* If this token is identifier S, fetches the next token and returns
 518    nonzero.
 519    Otherwise, reports an error and returns zero. */
 520 int
 521 lex_force_match_id (const char *s)
 522 {
 523   if (token == T_ID && lex_id_match (s, tokid))
 524     {
 525       lex_get ();
 526       return 1;
 527     }
 528   else
 529     {
 530       lex_error (_("expecting `%s'"), s);
 531       return 0;
 532     }
 533 }
 534
 535 /* If the current token is T, skips the token.  Otherwise, reports an
 536    error and returns from the current function with return value 0. */
 537 int
 538 lex_force_match (int t)
 539 {
 540   if (token == t)
 541     {
 542       lex_get ();
 543       return 1;
 544     }
 545   else
 546     {
 547       lex_error (_("expecting `%s'"), lex_token_name (t));
 548       return 0;
 549     }
 550 }
 551
 552 /* If this token is a string, does nothing and returns nonzero.
 553    Otherwise, reports an error and returns zero. */
 554 int
 555 lex_force_string (void)
 556 {
 557   if (token == T_STRING)
 558     return 1;
 559   else
 560     {
 561       lex_error (_("expecting string"));
 562       return 0;
 563     }
 564 }
 565
 566 /* If this token is an integer, does nothing and returns nonzero.
 567    Otherwise, reports an error and returns zero. */
 568 int
 569 lex_force_int (void)
 570 {
 571   if (lex_is_integer ())
 572     return 1;
 573   else
 574     {
 575       lex_error (_("expecting integer"));
 576       return 0;
 577     }
 578 }
 579
 580 /* If this token is a number, does nothing and returns nonzero.
 581    Otherwise, reports an error and returns zero. */
 582 int
 583 lex_force_num (void)
 584 {
 585   if (lex_is_number ())
 586     return 1;
 587   else
 588     {
 589       lex_error (_("expecting number"));
 590       return 0;
 591     }
 592 }
 593
 594 /* If this token is an identifier, does nothing and returns nonzero.
 595    Otherwise, reports an error and returns zero. */
 596 int
 597 lex_force_id (void)
 598 {
 599   if (token == T_ID)
 600     return 1;
 601   else
 602     {
 603       lex_error (_("expecting identifier"));
 604       return 0;
 605     }
 606 }
 607 \f
 608 /* Comparing identifiers. */
 609
 610 /* Keywords match if one of the following is true: KW and TOK are
 611    identical (except for differences in case), or TOK is at least 3
 612    characters long and those characters are identical to KW.  KW_LEN
 613    is the length of KW, TOK_LEN is the length of TOK. */
 614 int
 615 lex_id_match_len (const char *kw, size_t kw_len,
 616                   const char *tok, size_t tok_len)
 617 {
 618   size_t i = 0;
 619
 620   assert (kw && tok);
 621   for (;;)
 622     {
 623       if (i == kw_len && i == tok_len)
 624         return 1;
 625       else if (i == tok_len)
 626         return i >= 3;
 627       else if (i == kw_len)
 628         return 0;
 629       else if (toupper ((unsigned char) kw[i])
 630                != toupper ((unsigned char) tok[i]))
 631         return 0;
 632
 633       i++;
 634     }
 635 }
 636
 637 /* Same as lex_id_match_len() minus the need to pass in the lengths. */
 638 int
 639 lex_id_match (const char *kw, const char *tok)
 640 {
 641   return lex_id_match_len (kw, strlen (kw), tok, strlen (tok));
 642 }
 643
 644 /* Returns the proper token type, either T_ID or a reserved keyword
 645    enum, for ID[], which must contain LEN characters. */
 646 int
 647 lex_id_to_token (const char *id, size_t len)
 648 {
 649   const char **kwp;
 650
 651   if (len < 2 || len > 4)
 652     return T_ID;
 653
 654   for (kwp = keywords; *kwp; kwp++)
 655     if (!strcasecmp (*kwp, id))
 656       return T_FIRST_KEYWORD + (kwp - keywords);
 657
 658   return T_ID;
 659 }
 660 \f
 661 /* Weird token functions. */
 662
 663 /* Returns the first character of the next token, except that if the
 664    next token is not an identifier, the character returned will not be
 665    a character that can begin an identifier.  Specifically, the
 666    hexstring lead-in X' causes lookahead() to return '.  Note that an
 667    alphanumeric return value doesn't guarantee an ID token, it could
 668    also be a reserved-word token. */
 669 int
 670 lex_look_ahead (void)
 671 {
 672   if (put_token)
 673     return put_token;
 674
 675   for (;;)
 676     {
 677       if (eof)
 678         unexpected_eof ();
 679
 680       for (;;)
 681         {
 682           while (isspace ((unsigned char) *prog))
 683             prog++;
 684           if (*prog)
 685             break;
 686
 687           if (dot)
 688             return '.';
 689           else if (!lex_get_line ())
 690             unexpected_eof ();
 691
 692           if (put_token)
 693             return put_token;
 694         }
 695
 696       if ((toupper ((unsigned char) *prog) == 'X'
 697            || toupper ((unsigned char) *prog) == 'B')
 698           && (prog[1] == '\'' || prog[1] == '"'))
 699         return '\'';
 700
 701       return *prog;
 702     }
 703 }
 704
 705 /* Makes the current token become the next token to be read; the
 706    current token is set to T. */
 707 void
 708 lex_put_back (int t)
 709 {
 710   save_token ();
 711   token = t;
 712 }
 713
 714 /* Makes the current token become the next token to be read; the
 715    current token is set to the identifier ID. */
 716 void
 717 lex_put_back_id (const char *id)
 718 {
 719   assert (lex_id_to_token (id, strlen (id)) == T_ID);
 720   save_token ();
 721   token = T_ID;
 722   ds_replace (&tokstr, id);
 723   str_copy_trunc (tokid, sizeof tokid, ds_c_str (&tokstr));
 724 }
 725 \f
 726 /* Weird line processing functions. */
 727
 728 /* Returns the entire contents of the current line. */
 729 const char *
 730 lex_entire_line (void)
 731 {
 732   return ds_c_str (&getl_buf);
 733 }
 734
 735 /* As lex_entire_line(), but only returns the part of the current line
 736    that hasn't already been tokenized.
 737    If END_DOT is non-null, stores nonzero into *END_DOT if the line
 738    ends with a terminal dot, or zero if it doesn't. */
 739 const char *
 740 lex_rest_of_line (int *end_dot)
 741 {
 742   if (end_dot)
 743     *end_dot = dot;
 744   return prog;
 745 }
 746
 747 /* Causes the rest of the current input line to be ignored for
 748    tokenization purposes. */
 749 void
 750 lex_discard_line (void)
 751 {
 752   prog = ds_end (&getl_buf);
 753   dot = put_token = 0;
 754 }
 755
 756 /* Sets the current position in the current line to P, which must be
 757    in getl_buf. */
 758 void
 759 lex_set_prog (char *p)
 760 {
 761   prog = p;
 762 }
 763 \f
 764 /* Weird line reading functions. */
 765
 766 /* Read a line for use by the tokenizer. */
 767 int
 768 lex_get_line (void)
 769 {
 770   if (!getl_read_line ())
 771     return 0;
 772
 773   lex_preprocess_line ();
 774   return 1;
 775 }
 776
 777 /* Preprocesses getl_buf by removing comments, stripping trailing
 778    whitespace and the terminal dot, and removing leading indentors. */
 779 void
 780 lex_preprocess_line (void)
 781 {
 782   /* Strips comments. */
 783   {
 784     /* getl_buf iterator. */
 785     char *cp;
 786
 787     /* Nonzero inside a comment. */
 788     int comment;
 789
 790     /* Nonzero inside a quoted string. */
 791     int quote;
 792
 793     /* Remove C-style comments begun by slash-star and terminated by
 794        star-slash or newline. */
 795     quote = comment = 0;
 796     for (cp = ds_c_str (&getl_buf); *cp; )
 797       {
 798         /* If we're not commented out, toggle quoting. */
 799         if (!comment)
 800           {
 801             if (*cp == quote)
 802               quote = 0;
 803             else if (*cp == '\'' || *cp == '"')
 804               quote = *cp;
 805           }
 806
 807         /* If we're not quoting, toggle commenting. */
 808         if (!quote)
 809           {
 810             if (cp[0] == '/' && cp[1] == '*')
 811               {
 812                 comment = 1;
 813                 *cp++ = ' ';
 814                 *cp++ = ' ';
 815                 continue;
 816               }
 817             else if (cp[0] == '*' && cp[1] == '/' && comment)
 818               {
 819                 comment = 0;
 820                 *cp++ = ' ';
 821                 *cp++ = ' ';
 822                 continue;
 823               }
 824           }
 825
 826         /* Check commenting. */
 827         if (!comment)
 828           cp++;
 829         else
 830           *cp++ = ' ';
 831       }
 832   }
 833
 834   /* Strip trailing whitespace and terminal dot. */
 835   {
 836     size_t len = ds_length (&getl_buf);
 837     char *s = ds_c_str (&getl_buf);
 838
 839     /* Strip trailing whitespace. */
 840     while (len > 0 && isspace ((unsigned char) s[len - 1]))
 841       len--;
 842
 843     /* Check for and remove terminal dot. */
 844     if (len > 0 && s[len - 1] == get_endcmd() )
 845       {
 846         dot = 1;
 847         len--;
 848       }
 849     else if (len == 0 && get_nullline() )
 850       dot = 1;
 851     else
 852       dot = 0;
 853
 854     /* Set length. */
 855     ds_truncate (&getl_buf, len);
 856   }
 857
 858   /* In batch mode, strip leading indentors and insert a terminal dot
 859      as necessary. */
 860   if (getl_interactive != 2 && getl_mode == GETL_MODE_BATCH)
 861     {
 862       char *s = ds_c_str (&getl_buf);
 863
 864       if (s[0] == '+' || s[0] == '-' || s[0] == '.')
 865         s[0] = ' ';
 866       else if (s[0] && !isspace ((unsigned char) s[0]))
 867         put_token = '.';
 868     }
 869
 870   prog = ds_c_str (&getl_buf);
 871 }
 872 \f
 873 /* Token names. */
 874
 875 /* Returns the name of a token in a static buffer. */
 876 const char *
 877 lex_token_name (int token)
 878 {
 879   if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
 880     return keywords[token - T_FIRST_KEYWORD];
 881
 882   if (token < 256)
 883     {
 884       static char t[2];
 885       t[0] = token;
 886       return t;
 887     }
 888
 889   return _("<ERROR>");
 890 }
 891
 892 /* Returns an ASCII representation of the current token as a
 893    malloc()'d string. */
 894 char *
 895 lex_token_representation (void)
 896 {
 897   char *token_rep;
 898
 899   switch (token)
 900     {
 901     case T_ID:
 902     case T_POS_NUM:
 903     case T_NEG_NUM:
 904       return xstrdup (ds_c_str (&tokstr));
 905       break;
 906
 907     case T_STRING:
 908       {
 909         int hexstring = 0;
 910         char *sp, *dp;
 911
 912         for (sp = ds_c_str (&tokstr); sp < ds_end (&tokstr); sp++)
 913           if (!isprint ((unsigned char) *sp))
 914             {
 915               hexstring = 1;
 916               break;
 917             }
 918
 919         token_rep = xmalloc (2 + ds_length (&tokstr) * 2 + 1 + 1);
 920
 921         dp = token_rep;
 922         if (hexstring)
 923           *dp++ = 'X';
 924         *dp++ = '\'';
 925
 926         if (!hexstring)
 927           for (sp = ds_c_str (&tokstr); *sp; )
 928             {
 929               if (*sp == '\'')
 930                 *dp++ = '\'';
 931               *dp++ = (unsigned char) *sp++;
 932             }
 933         else
 934           for (sp = ds_c_str (&tokstr); sp < ds_end (&tokstr); sp++)
 935             {
 936               *dp++ = (((unsigned char) *sp) >> 4)["0123456789ABCDEF"];
 937               *dp++ = (((unsigned char) *sp) & 15)["0123456789ABCDEF"];
 938             }
 939         *dp++ = '\'';
 940         *dp = '\0';
 941
 942         return token_rep;
 943       }
 944     break;
 945
 946     case T_STOP:
 947       token_rep = xmalloc (1);
 948       *token_rep = '\0';
 949       return token_rep;
 950
 951     case T_EXP:
 952       return xstrdup ("**");
 953
 954     default:
 955       if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
 956         return xstrdup (keywords [token - T_FIRST_KEYWORD]);
 957       else
 958         {
 959           token_rep = xmalloc (2);
 960           token_rep[0] = token;
 961           token_rep[1] = '\0';
 962           return token_rep;
 963         }
 964     }
 965
 966   assert (0);
 967 }
 968 \f
 969 /* Really weird functions. */
 970
 971 /* Most of the time, a `-' is a lead-in to a negative number.  But
 972    sometimes it's actually part of the syntax.  If a dash can be part
 973    of syntax then this function is called to rip it off of a
 974    number. */
 975 void
 976 lex_negative_to_dash (void)
 977 {
 978   if (token == T_NEG_NUM)
 979     {
 980       token = T_POS_NUM;
 981       tokval = -tokval;
 982       ds_replace (&tokstr, ds_c_str (&tokstr) + 1);
 983       save_token ();
 984       token = '-';
 985     }
 986 }
 987
 988 /* We're not at eof any more. */
 989 void
 990 lex_reset_eof (void)
 991 {
 992   eof = 0;
 993 }
 994
 995 /* Skip a COMMENT command. */
 996 void
 997 lex_skip_comment (void)
 998 {
 999   for (;;)
1000     {
1001       if (!lex_get_line ())
1002         {
1003           put_token = T_STOP;
1004           eof = 1;
1005           return;
1006         }
1007
1008       if (put_token == '.')
1009         break;
1010
1011       prog = ds_end (&getl_buf);
1012       if (dot)
1013         break;
1014     }
1015 }
1016 \f
1017 /* Private functions. */
1018
1019 /* Unexpected end of file. */
1020 static void
1021 unexpected_eof (void)
1022 {
1023   msg (FE, _("Unexpected end of file."));
1024 }
1025
1026 /* When invoked, tokstr contains a string of binary, octal, or hex
1027    digits, for values of TYPE of 0, 1, or 2, respectively.  The string
1028    is converted to characters having the specified values. */
1029 static void
1030 convert_numeric_string_to_char_string (int type)
1031 {
1032   static const char *base_names[] = {N_("binary"), N_("octal"), N_("hex")};
1033   static const int bases[] = {2, 8, 16};
1034   static const int chars_per_byte[] = {8, 3, 2};
1035
1036   const char *const base_name = base_names[type];
1037   const int base = bases[type];
1038   const int cpb = chars_per_byte[type];
1039   const int nb = ds_length (&tokstr) / cpb;
1040   int i;
1041   char *p;
1042
1043   assert (type >= 0 && type <= 2);
1044
1045   if (ds_length (&tokstr) % cpb)
1046     msg (SE, _("String of %s digits has %d characters, which is not a "
1047                "multiple of %d."),
1048          gettext (base_name), ds_length (&tokstr), cpb);
1049
1050   p = ds_c_str (&tokstr);
1051   for (i = 0; i < nb; i++)
1052     {
1053       int value;
1054       int j;
1055
1056       value = 0;
1057       for (j = 0; j < cpb; j++, p++)
1058         {
1059           int v;
1060
1061           if (*p >= '0' && *p <= '9')
1062             v = *p - '0';
1063           else
1064             {
1065               static const char alpha[] = "abcdef";
1066               const char *q = strchr (alpha, tolower ((unsigned char) *p));
1067
1068               if (q)
1069                 v = q - alpha + 10;
1070               else
1071                 v = base;
1072             }
1073
1074           if (v >= base)
1075             msg (SE, _("`%c' is not a valid %s digit."), *p, base_name);
1076
1077           value = value * base + v;
1078         }
1079
1080       ds_c_str (&tokstr)[i] = (unsigned char) value;
1081     }
1082
1083   ds_truncate (&tokstr, nb);
1084 }
1085
1086 /* Parses a string from the input buffer into tokstr.  The input
1087    buffer pointer prog must point to the initial single or double
1088    quote.  TYPE is 0 if it is an ordinary string, or 1, 2, or 3 for a
1089    binary, octal, or hexstring, respectively.  Returns token type. */
1090 static int
1091 parse_string (int type)
1092 {
1093   /* Accumulate the entire string, joining sections indicated by +
1094      signs. */
1095   for (;;)
1096     {
1097       /* Single or double quote. */
1098       int c = *prog++;
1099
1100       /* Accumulate section. */
1101       for (;;)
1102         {
1103           /* Check end of line. */
1104           if (*prog == 0)
1105             {
1106               msg (SE, _("Unterminated string constant."));
1107               goto finish;
1108             }
1109
1110           /* Double quote characters to embed them in strings. */
1111           if (*prog == c)
1112             {
1113               if (prog[1] == c)
1114                 prog++;
1115               else
1116                 break;
1117             }
1118
1119           ds_putc (&tokstr, *prog++);
1120         }
1121       prog++;
1122
1123       /* Skip whitespace after final quote mark. */
1124       if (eof)
1125         break;
1126       for (;;)
1127         {
1128           while (isspace ((unsigned char) *prog))
1129             prog++;
1130           if (*prog)
1131             break;
1132
1133           if (dot)
1134             goto finish;
1135
1136           if (!lex_get_line ())
1137             unexpected_eof ();
1138         }
1139
1140       /* Skip plus sign. */
1141       if (*prog != '+')
1142         break;
1143       prog++;
1144
1145       /* Skip whitespace after plus sign. */
1146       if (eof)
1147         break;
1148       for (;;)
1149         {
1150           while (isspace ((unsigned char) *prog))
1151             prog++;
1152           if (*prog)
1153             break;
1154
1155           if (dot)
1156             goto finish;
1157
1158           if (!lex_get_line ())
1159             unexpected_eof ();
1160         }
1161
1162       /* Ensure that a valid string follows. */
1163       if (*prog != '\'' && *prog != '"')
1164         {
1165           msg (SE, "String expected following `+'.");
1166           goto finish;
1167         }
1168     }
1169
1170   /* We come here when we've finished concatenating all the string sections
1171      into one large string. */
1172 finish:
1173   if (type != 0)
1174     convert_numeric_string_to_char_string (type - 1);
1175
1176   if (ds_length (&tokstr) > 255)
1177     {
1178       msg (SE, _("String exceeds 255 characters in length (%d characters)."),
1179            ds_length (&tokstr));
1180       ds_truncate (&tokstr, 255);
1181     }
1182
1183   {
1184     /* FIXME. */
1185     size_t i;
1186     int warned = 0;
1187
1188     for (i = 0; i < ds_length (&tokstr); i++)
1189       if (ds_c_str (&tokstr)[i] == 0)
1190         {
1191           if (!warned)
1192             {
1193               msg (SE, _("Sorry, literal strings may not contain null "
1194                          "characters.  Replacing with spaces."));
1195               warned = 1;
1196             }
1197           ds_c_str (&tokstr)[i] = ' ';
1198         }
1199   }
1200
1201   return T_STRING;
1202 }
1203 \f
1204 #if DUMP_TOKENS
1205 /* Reads one token from the lexer and writes a textual representation
1206    on stdout for debugging purposes. */
1207 static void
1208 dump_token (void)
1209 {
1210   {
1211     const char *curfn;
1212     int curln;
1213
1214     getl_location (&curfn, &curln);
1215     if (curfn)
1216       fprintf (stderr, "%s:%d\t", curfn, curln);
1217   }
1218
1219   switch (token)
1220     {
1221     case T_ID:
1222       fprintf (stderr, "ID\t%s\n", tokid);
1223       break;
1224
1225     case T_POS_NUM:
1226     case T_NEG_NUM:
1227       fprintf (stderr, "NUM\t%f\n", tokval);
1228       break;
1229
1230     case T_STRING:
1231       fprintf (stderr, "STRING\t\"%s\"\n", ds_c_str (&tokstr));
1232       break;
1233
1234     case T_STOP:
1235       fprintf (stderr, "STOP\n");
1236       break;
1237
1238     case T_EXP:
1239       fprintf (stderr, "MISC\tEXP\"");
1240       break;
1241
1242     case 0:
1243       fprintf (stderr, "MISC\tEOF\n");
1244       break;
1245
1246     default:
1247       if (token >= T_FIRST_KEYWORD && token <= T_LAST_KEYWORD)
1248         fprintf (stderr, "KEYWORD\t%s\n", lex_token_name (token));
1249       else
1250         fprintf (stderr, "PUNCT\t%c\n", token);
1251       break;
1252     }
1253 }
1254 #endif /* DUMP_TOKENS */