src/lexer.c

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