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