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