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