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