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