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