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