20b245986b127b3bc8ddd703048d11def95f7682
[pspp-builds.git] / src / q2c.c
1 /* q2c - parser generator for PSPP procedures.
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 <assert.h>
22 #include <ctype.h>
23 #include <stdio.h>
24 #include <stdlib.h>
25 #include <stdarg.h>
26 #include <time.h>
27 #include <errno.h>
28 #if HAVE_UNISTD_H
29 #include <unistd.h>
30 #endif
31 #include "str.h"
32
33 /* Brokenness. */
34 #ifndef EXIT_SUCCESS
35 #define EXIT_SUCCESS 0
36 #endif
37
38 #ifndef EXIT_FAILURE
39 #define EXIT_FAILURE 1
40 #endif
41
42 #if !HAVE_STRERROR
43 #include "misc/strerror.c"
44 #endif
45      
46 #include "debug-print.h"
47
48 /* Max length of an input line. */
49 #define MAX_LINE_LEN 1024
50
51 /* Max token length. */
52 #define MAX_TOK_LEN 1024
53
54 /* argv[0]. */
55 char *pgmname;
56
57 /* Have the input and output files been opened yet? */
58 int is_open;
59
60 /* Input, output files. */
61 FILE *in, *out;
62
63 /* Input, output file names. */
64 char *ifn, *ofn;
65
66 /* Input, output file line number. */
67 int ln, oln = 1;
68
69 /* Input line buffer, current position. */
70 char *buf, *cp;
71
72 /* Token types. */
73 enum
74   {
75     T_STRING = 256,     /* String literal. */
76     T_ID = 257          /* Identifier.  */
77   };
78
79 /* Current token: either one of the above, or a single character. */
80 int token;
81
82 /* Token string value. */
83 char *tokstr;
84 \f
85 /* Utility functions. */
86
87 char nullstr[] = "";
88
89 /* Close all open files and delete the output file, on failure. */
90 static void
91 finish_up (void)
92 {
93   if (!is_open)
94     return;
95   is_open = 0;
96   fclose (in);
97   fclose (out);
98   if (remove (ofn) == -1)
99     fprintf (stderr, "%s: %s: remove: %s\n", pgmname, ofn, strerror (errno));
100 }
101
102 void hcf (void) NO_RETURN;
103
104 /* Terminate unsuccessfully. */
105 void
106 hcf (void)
107 {
108   finish_up ();
109   exit (EXIT_FAILURE);
110 }
111
112 int fail (const char *, ...) PRINTF_FORMAT (1, 2);
113 int error (const char *, ...) PRINTF_FORMAT (1, 2);
114
115 /* Output an error message and terminate unsuccessfully. */
116 int
117 fail (const char *format, ...)
118 {
119   va_list args;
120
121   va_start (args, format);
122   fprintf (stderr, "%s: ", pgmname);
123   vfprintf (stderr, format, args);
124   fprintf (stderr, "\n");
125   va_end (args);
126
127   hcf ();
128 }
129
130 /* Output a context-dependent error message and terminate
131    unsuccessfully. */
132 int
133 error (const char *format,...)
134 {
135   va_list args;
136
137   va_start (args, format);
138   fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
139   vfprintf (stderr, format, args);
140   fprintf (stderr, "\n");
141   va_end (args);
142
143   hcf ();
144 }
145
146 #define VME "virtual memory exhausted"
147
148 /* Allocate a block of SIZE bytes and return a pointer to its
149    beginning. */
150 static void *
151 xmalloc (size_t size)
152 {
153   void *vp;
154   
155   if (size == 0)
156     return NULL;
157   
158   vp = malloc (size);
159   if (!vp)
160     fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
161   
162   return vp;
163 }
164
165 /* Make a dynamically allocated copy of string S and return a pointer
166    to the first character. */
167 static char *
168 xstrdup (const char *s)
169 {
170   size_t size;
171   char *t;
172
173   assert (s != NULL);
174   size = strlen (s) + 1;
175   
176   t = malloc (size);
177   if (!t)
178     fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
179     
180   memcpy (t, s, size);
181   return t;
182 }
183
184 /* Returns a pointer to one of 8 static buffers.  The buffers are used
185    in rotation. */
186 static char *
187 get_buffer (void)
188 {
189   static char b[8][256];
190   static int cb;
191
192   if (++cb >= 8)
193     cb = 0;
194   
195   return b[cb];
196 }
197    
198 /* Copies a string to a static buffer, converting it to lowercase in
199    the process, and returns a pointer to the static buffer. */
200 static char *
201 st_lower (const char *s)
202 {
203   char *p, *cp;
204   
205   p = cp = get_buffer ();
206   while (*s)
207     *cp++ = tolower ((unsigned char) (*s++));
208   *cp++ = '\0';
209   
210   return p;
211 }
212
213 /* Copies a string to a static buffer, converting it to uppercase in
214    the process, and returns a pointer to the static buffer. */
215 static char *
216 st_upper (const char *s)
217 {
218   char *p, *cp;
219
220   p = cp = get_buffer ();
221   while (*s)
222     *cp++ = toupper ((unsigned char) (*s++));
223   *cp++ = '\0';
224   
225   return p;
226 }
227
228 /* Returns the address of the first non-whitespace character in S, or
229    the address of the null terminator if none. */
230 static char *
231 skip_ws (const char *s)
232 {
233   while (isspace ((unsigned char) *s))
234     s++;
235   return (char *) s;
236 }
237
238 /* Read one line from the input file into buf.  Lines having special
239    formats are handled specially. */
240 static int
241 get_line (void)
242 {
243   ln++;
244   if (0 == fgets (buf, MAX_LINE_LEN, in))
245     {
246       if (ferror (in))
247         fail ("%s: fgets: %s", ifn, strerror (errno));
248       return 0;
249     }
250
251   cp = strchr (buf, '\n');
252   if (cp != NULL)
253     *cp = '\0';
254
255   cp = buf;
256   return 1;
257 }
258 \f
259 /* Symbol table manager. */
260
261 /* Symbol table entry. */
262 typedef struct symbol symbol;
263 struct symbol
264   {
265     symbol *next;               /* Next symbol in symbol table. */
266     char *name;                 /* Symbol name. */
267     int unique;                 /* 1=Name must be unique in this file. */
268     int ln;                     /* Line number of definition. */
269     int value;                  /* Symbol value. */
270   };
271
272 /* Symbol table. */
273 symbol *symtab;
274
275 /* Add a symbol to the symbol table having name NAME, uniqueness
276    UNIQUE, and value VALUE.  If a symbol having the same name is found
277    in the symbol table, its sequence number is returned and the symbol
278    table is not modified.  Otherwise, the symbol is added and the next
279    available sequence number is returned. */
280 static int
281 add_symbol (const char *name, int unique, int value)
282 {
283   symbol *iter, *sym;
284   int x;
285
286   sym = xmalloc (sizeof (symbol));
287   sym->name = xstrdup (name);
288   sym->unique = unique;
289   sym->value = value;
290   sym->next = NULL;
291   sym->ln = ln;
292   if (!symtab)
293     {
294       symtab = sym;
295       return 1;
296     }
297   iter = symtab;
298   x = 1;
299   for (;;)
300     {
301       if (!strcmp (iter->name, name))
302         {
303           if (iter->unique)
304             {
305               fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
306                        ln, name);
307               fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
308                        iter->ln);
309               hcf ();
310             }
311           free (sym->name);
312           free (sym);
313           return x;
314         }
315       if (!iter->next)
316         break;
317       iter = iter->next;
318       x++;
319     }
320   iter->next = sym;
321   return ++x;
322 }
323
324 /* Finds the symbol having given sequence number X within the symbol
325    table, and returns the associated symbol structure. */
326 static symbol *
327 find_symbol (int x)
328 {
329   symbol *iter;
330
331   iter = symtab;
332   while (x > 1 && iter)
333     {
334       iter = iter->next;
335       x--;
336     }
337   assert (iter);
338   return iter;
339 }
340
341 #if DEBUGGING
342 /* Writes a printable representation of the current token to
343    stdout. */
344 void
345 dump_token (void)
346 {
347   switch (token)
348     {
349     case T_STRING:
350       printf ("STRING\t\"%s\"\n", tokstr);
351       break;
352     case T_ID:
353       printf ("ID\t%s\n", tokstr);
354       break;
355     default:
356       printf ("PUNCT\t%c\n", token);
357     }
358 }
359 #endif /* DEBUGGING */
360
361 /* Reads a token from the input file. */
362 static int
363 lex_get (void)
364 {
365   /* Skip whitespace and check for end of file. */
366   for (;;)
367     {
368       cp = skip_ws (cp);
369       if (*cp != '\0')
370         break;
371       
372       if (!get_line ())
373         fail ("%s: Unexpected end of file.", ifn);
374     }
375   
376   if (*cp == '_' || isalnum ((unsigned char) *cp))
377     {
378       char *dest = tokstr;
379       token = T_ID;
380       while (*cp == '_' || isalnum ((unsigned char) *cp))
381         *dest++ = toupper ((unsigned char) (*cp++));
382       *dest++ = '\0';
383     }
384   else if (*cp == '"')
385     {
386       char *dest = tokstr;
387       token = T_STRING;
388       cp++;
389       while (*cp != '"' && *cp)
390         {
391           if (*cp == '\\')
392             {
393               cp++;
394               if (!*cp)
395                 error ("Unterminated string literal.");
396               *dest++ = *cp++;
397             }
398           else
399             *dest++ = *cp++;
400         }
401       *dest++ = 0;
402       if (!*cp)
403         error ("Unterminated string literal.");
404       cp++;
405     }
406   else
407     token = *cp++;
408   
409 #if DEBUGGING
410   dump_token ();
411 #endif
412   
413   return token;
414 }
415
416 /* Force the current token to be an identifier token. */
417 static void
418 force_id (void)
419 {
420   if (token != T_ID)
421     error ("Identifier expected.");
422 }
423
424 /* Force the current token to be a string token. */
425 static void
426 force_string (void)
427 {
428   if (token != T_STRING)
429     error ("String expected.");
430 }
431
432 /* Checks whether the current token is the identifier S; if so, skips
433    the token and returns 1; otherwise, returns 0. */
434 static int
435 match_id (const char *s)
436 {
437   if (token == T_ID && !strcmp (tokstr, s))
438     {
439       lex_get ();
440       return 1;
441     }
442   return 0;
443 }
444
445 /* Checks whether the current token is T.  If so, skips the token and
446    returns 1; otherwise, returns 0. */
447 static int
448 match_token (int t)
449 {
450   if (token == t)
451     {
452       lex_get ();
453       return 1;
454     }
455   return 0;
456 }
457
458 /* Force the current token to be T, and skip it. */
459 static void
460 skip_token (int t)
461 {
462   if (token != t)
463     error ("`%c' expected.", t);
464   lex_get ();
465 }
466 \f
467 /* Structures. */
468
469 /* Some specifiers have associated values. */
470 enum
471   {
472     VAL_NONE,   /* No value. */
473     VAL_INT,    /* Integer value. */
474     VAL_DBL     /* Floating point value. */
475   };
476
477 /* For those specifiers with values, the syntax of those values. */
478 enum
479   {
480     VT_PLAIN,   /* Unadorned value. */
481     VT_PAREN    /* Value must be enclosed in parentheses. */
482   };
483
484 /* Forward definition. */
485 typedef struct specifier specifier;
486
487 /* A single setting. */
488 typedef struct setting setting;
489 struct setting
490   {
491     specifier *parent;  /* Owning specifier. */
492     setting *next;      /* Next in the chain. */
493     char *specname;     /* Name of the setting. */
494     int con;            /* Sequence number. */
495
496     /* Values. */
497     int valtype;        /* One of VT_*. */
498     int value;          /* One of VAL_*. */
499     int optvalue;       /* 1=value is optional, 0=value is required. */
500     char *valname;      /* Variable name for the value. */
501     char *restriction;  /* !=NULL: expression specifying valid values. */
502   };
503
504 /* A single specifier. */
505 struct specifier
506   {
507     specifier *next;    /* Next in the chain. */
508     char *varname;      /* Variable name. */
509     setting *s;         /* Associated settings. */
510
511     setting *def;       /* Default setting. */
512     setting *omit_kw;   /* Setting for which the keyword can be omitted. */
513     
514     int index;          /* Next array index. */
515   };
516
517 /* Subcommand types. */
518 typedef enum
519   {
520     SBC_PLAIN,          /* The usual case. */
521     SBC_VARLIST,        /* Variable list. */
522     SBC_INT,            /* Integer value. */
523     SBC_PINT,           /* Integer inside parentheses. */
524     SBC_DBL,            /* Floating point value. */
525     SBC_INT_LIST,       /* List of integers (?). */
526     SBC_DBL_LIST,       /* List of floating points (?). */
527     SBC_CUSTOM,         /* Custom. */
528     SBC_ARRAY,          /* Array of boolean values. */
529     SBC_STRING,         /* String value. */
530     SBC_VAR             /* Single variable name. */
531   }
532 subcommand_type;
533
534 /* A single subcommand. */
535 typedef struct subcommand subcommand;
536 struct subcommand
537   {
538     subcommand *next;           /* Next in the chain. */
539     char *name;                 /* Subcommand name. */
540     subcommand_type type;       /* One of SBC_*. */
541     int once;                   /* 1=Subcommand may appear only once. */
542     int narray;                 /* Index of next array element. */
543     const char *prefix;         /* Prefix for variable and constant names. */
544     specifier *spec;            /* Array of specifiers. */
545     
546     /* SBC_STRING only. */
547     char *restriction;          /* Expression restricting string length. */
548     char *message;              /* Error message. */
549   };
550
551 /* Name of the command; i.e., DESCRIPTIVES. */
552 char *cmdname;
553
554 /* Short prefix for the command; i.e., `dsc_'. */
555 char *prefix;
556
557 /* List of subcommands. */
558 subcommand *subcommands;
559
560 /* Default subcommand if any, or NULL. */
561 subcommand *def;
562 \f
563 /* Parsing. */
564
565 void parse_subcommands (void);
566
567 /* Parse an entire specification. */
568 static void
569 parse (void)
570 {
571   /* Get the command name and prefix. */
572   if (token != T_STRING && token != T_ID)
573     error ("Command name expected.");
574   cmdname = xstrdup (tokstr);
575   lex_get ();
576   skip_token ('(');
577   force_id ();
578   prefix = xstrdup (tokstr);
579   lex_get ();
580   skip_token (')');
581   skip_token (':');
582
583   /* Read all the subcommands. */
584   subcommands = NULL;
585   def = NULL;
586   parse_subcommands ();
587 }
588
589 /* Parses a single setting into S, given subcommand information SBC
590    and specifier information SPEC. */
591 static void
592 parse_setting (setting *s, specifier *spec)
593 {
594   s->parent = spec;
595   
596   if (match_token ('*'))
597     {
598       if (spec->omit_kw)
599         error ("Cannot have two settings with omittable keywords.");
600       else
601         spec->omit_kw = s;
602     }
603   
604   if (match_token ('!'))
605     {
606       if (spec->def)
607         error ("Cannot have two default settings.");
608       else
609         spec->def = s;
610     }
611   
612   force_id ();
613   s->specname = xstrdup (tokstr);
614   s->con = add_symbol (s->specname, 0, 0);
615   s->value = VAL_NONE;
616
617   lex_get ();
618
619   /* Parse setting value info if necessary. */
620   if (token != '/' && token != ';' && token != '.' && token != ',')
621     {
622       if (token == '(')
623         {
624           s->valtype = VT_PAREN;
625           lex_get ();
626         }
627       else
628         s->valtype = VT_PLAIN;
629
630       s->optvalue = match_token ('*');
631       
632       if (match_id ("N"))
633         s->value = VAL_INT;
634       else if (match_id ("D"))
635         s->value = VAL_DBL;
636       else
637         error ("`n' or `d' expected.");
638       
639       skip_token (':');
640       
641       force_id ();
642       s->valname = xstrdup (tokstr);
643       lex_get ();
644       
645       if (token == ',')
646         {
647           lex_get ();
648           force_string ();
649           s->restriction = xstrdup (tokstr);
650           lex_get ();
651         }
652       else
653         s->restriction = NULL;
654       
655       if (s->valtype == VT_PAREN)
656         skip_token (')');
657     }
658 }
659
660 /* Parse a single specifier into SPEC, given subcommand information
661    SBC. */
662 static void
663 parse_specifier (specifier *spec, subcommand *sbc)
664 {
665   spec->index = 0;
666   spec->s = NULL;
667   spec->def = NULL;
668   spec->omit_kw = NULL;
669   spec->varname = NULL;
670
671   if (token == T_ID)
672     {
673       spec->varname = xstrdup (st_lower (tokstr));
674       lex_get ();
675     }
676   
677   /* Handle array elements. */
678   if (token != ':')
679     {
680       spec->index = sbc->narray;
681       if (sbc->type == SBC_ARRAY)
682         {
683           if (token == '|')
684             token = ',';
685           else
686             sbc->narray++;
687         }
688       spec->s = NULL;
689       return;
690     }
691   skip_token (':');
692   
693   /* Parse all the settings. */
694   {
695     setting **s = &spec->s;
696     
697     for (;;)
698       {
699         *s = xmalloc (sizeof (setting));
700         parse_setting (*s, spec);
701         if (token == ',' || token == ';' || token == '.')
702           break;
703         skip_token ('/');
704         s = &(*s)->next;
705       }
706     (*s)->next = NULL;
707   }
708 }
709
710 /* Parse a list of specifiers for subcommand SBC. */
711 static void
712 parse_specifiers (subcommand *sbc)
713 {
714   specifier **spec = &sbc->spec;
715
716   if (token == ';' || token == '.')
717     {
718       *spec = NULL;
719       return;
720     }
721   
722   for (;;)
723     {
724       *spec = xmalloc (sizeof (specifier));
725       parse_specifier (*spec, sbc);
726       if (token == ';' || token == '.')
727         break;
728       skip_token (',');
729       spec = &(*spec)->next;
730     }
731   (*spec)->next = NULL;
732 }
733
734 /* Parse a subcommand into SBC. */
735 static void
736 parse_subcommand (subcommand *sbc)
737 {
738   if (match_token ('*'))
739     {
740       if (def)
741         error ("Multiple default subcommands.");
742       def = sbc;
743     }
744
745   sbc->once = match_token ('+');
746
747   force_id ();
748   sbc->name = xstrdup (tokstr);
749   lex_get ();
750   
751   sbc->narray = 0;
752   sbc->type = SBC_PLAIN;
753   sbc->spec = NULL;
754
755   if (match_token ('['))
756     {
757       force_id ();
758       sbc->prefix = xstrdup (st_lower (tokstr));
759       lex_get ();
760       
761       skip_token (']');
762       skip_token ('=');
763       
764       sbc->type = SBC_ARRAY;
765       parse_specifiers (sbc);
766     }
767   else
768     {
769       if (match_token ('('))
770         {
771           force_id ();
772           sbc->prefix = xstrdup (st_lower (tokstr));
773           lex_get ();
774           
775           skip_token (')');
776         }
777       else
778         sbc->prefix = "";
779       
780       skip_token ('=');
781
782       if (match_id ("VAR"))
783         sbc->type = SBC_VAR;
784       if (match_id ("VARLIST"))
785         {
786           if (match_token ('('))
787             {
788               force_string ();
789               sbc->message = xstrdup (tokstr);
790               lex_get();
791               
792               skip_token (')');
793             }
794           else sbc->message = NULL;
795
796           sbc->type = SBC_VARLIST;
797         }
798       else if (match_id ("INTEGER"))
799         sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
800       else if (match_id ("PINT"))
801         sbc->type = SBC_PINT;
802       else if (match_id ("DOUBLE"))
803         sbc->type = match_id ("LIST") ? SBC_DBL_LIST : SBC_DBL;
804       else if (match_id ("STRING"))
805         {
806           sbc->type = SBC_STRING;
807           if (token == T_STRING)
808             {
809               sbc->restriction = xstrdup (tokstr);
810               lex_get ();
811               force_string ();
812               sbc->message = xstrdup (tokstr);
813               lex_get ();
814             }
815           else
816             sbc->restriction = NULL;
817         }
818       else if (match_id ("CUSTOM"))
819         sbc->type = SBC_CUSTOM;
820       else
821         parse_specifiers (sbc);
822     }
823 }
824
825 /* Parse all the subcommands. */
826 void
827 parse_subcommands (void)
828 {
829   subcommand **sbc = &subcommands;
830   
831   for (;;)
832     {
833       *sbc = xmalloc (sizeof (subcommand));
834       (*sbc)->next = NULL;
835
836       parse_subcommand (*sbc);
837
838       if (token == '.')
839         return;
840
841       skip_token (';');
842       sbc = &(*sbc)->next;
843     }
844 }
845 \f
846 /* Output. */
847
848 #define BASE_INDENT 2           /* Starting indent. */
849 #define INC_INDENT 2            /* Indent increment. */
850
851 /* Increment the indent. */
852 #define indent() indent += INC_INDENT
853 #define outdent() indent -= INC_INDENT
854
855 /* Size of the indent from the left margin. */
856 int indent;
857
858 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
859
860 /* Write line FORMAT to the output file, formatted as with printf,
861    indented `indent' characters from the left margin.  If INDENTION is
862    greater than 0, indents BASE_INDENT * INDENTION characters after
863    writing the line; if INDENTION is less than 0, dedents BASE_INDENT
864    * INDENTION characters _before_ writing the line. */
865 void
866 dump (int indention, const char *format, ...)
867 {
868   va_list args;
869   int i;
870
871   if (indention < 0)
872     indent += BASE_INDENT * indention;
873   
874   oln++;
875   va_start (args, format);
876   for (i = 0; i < indent; i++)
877     putc (' ', out);
878   vfprintf (out, format, args);
879   putc ('\n', out);
880   va_end (args);
881
882   if (indention > 0)
883     indent += BASE_INDENT * indention;
884 }
885
886 /* Write the structure members for specifier SPEC to the output file.
887    SBC is the including subcommand. */
888 static void
889 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
890 {
891   if (spec->varname)
892     dump (0, "long %s%s;", sbc->prefix, spec->varname);
893   
894   {
895     setting *s;
896
897     for (s = spec->s; s; s = s->next)
898       {
899         if (s->value != VAL_NONE)
900           {
901             const char *typename;
902
903             assert (s->value == VAL_INT || s->value == VAL_DBL);
904             typename = s->value == VAL_INT ? "long" : "double";
905
906             dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
907           }
908       }
909   }
910 }
911
912 /* Returns 1 if string T is a PSPP keyword, 0 otherwise. */
913 static int
914 is_keyword (const char *t)
915 {
916   static const char *kw[] =
917     {
918       "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
919       "NE", "ALL", "BY", "TO", "WITH", 0,
920     };
921   const char **cp;
922
923   for (cp = kw; *cp; cp++)
924     if (!strcmp (t, *cp))
925       return 1;
926   return 0;
927 }
928
929 /* Transforms a string NAME into a valid C identifier: makes
930    everything lowercase and maps nonalphabetic characters to
931    underscores.  Returns a pointer to a static buffer. */
932 static char *
933 make_identifier (const char *name)
934 {
935   char *p = get_buffer ();
936   char *cp;
937
938   for (cp = p; *name; name++)
939     if (isalpha ((unsigned char) *name))
940       *cp++ = tolower ((unsigned char) (*name));
941     else
942       *cp++ = '_';
943   *cp = '\0';
944   
945   return p;
946 }
947
948 /* Writes the struct and enum declarations for the parser. */
949 static void
950 dump_declarations (void)
951 {
952   indent = 0;
953
954   /* Write out enums for all the identifiers in the symbol table. */
955   {
956     int f, k;
957     symbol *sym;
958     char *buf = NULL;
959
960     /* Note the squirmings necessary to make sure that the last enum
961        is not followed by a comma, as mandated by ANSI C89. */
962     for (sym = symtab, f = k = 0; sym; sym = sym->next)
963       if (!sym->unique && !is_keyword (sym->name))
964         {
965           if (!f)
966             {
967               dump (0, "/* Settings for subcommand specifiers. */");
968               dump (1, "enum");
969               dump (1, "{");
970               f = 1;
971             }
972
973           if (buf == NULL)
974             buf = xmalloc (1024);
975           else
976             dump (0, buf);
977           
978           if (k)
979             sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
980           else
981             {
982               k = 1;
983               sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
984             }
985         }
986     if (buf)
987       {
988         buf[strlen (buf) - 1] = 0;
989         dump (0, buf);
990         free (buf);
991       }
992     if (f)
993       {
994         dump (-1, "};");
995         dump (-1, nullstr);
996       }
997   }
998
999   /* For every array subcommand, write out the associated enumerated
1000      values. */
1001   {
1002     subcommand *sbc;
1003
1004     for (sbc = subcommands; sbc; sbc = sbc->next)
1005       if (sbc->type == SBC_ARRAY && sbc->narray)
1006         {
1007           dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1008           
1009           dump (1, "enum");
1010           dump (1, "{");
1011
1012           {
1013             specifier *spec;
1014
1015             for (spec = sbc->spec; spec; spec = spec->next)
1016               if (!spec->s)
1017                 dump (0, "%s%s%s = %d,",
1018                       st_upper (prefix), st_upper (sbc->prefix),
1019                       st_upper (spec->varname), spec->index);
1020
1021             dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1022
1023             dump (-1, "};");
1024             dump (-1, nullstr);
1025           }
1026         }
1027   }
1028
1029   /* Write out structure declaration. */
1030   {
1031     subcommand *sbc;
1032
1033     dump (0, "/* %s structure. */", cmdname);
1034     dump (1, "struct cmd_%s", make_identifier (cmdname));
1035     dump (1, "{");
1036     for (sbc = subcommands; sbc; sbc = sbc->next)
1037       {
1038         int f = 0;
1039
1040         if (sbc != subcommands)
1041           dump (0, nullstr);
1042         
1043         dump (0, "/* %s subcommand. */", sbc->name);
1044         dump (0, "int sbc_%s;", st_lower (sbc->name));
1045
1046         switch (sbc->type)
1047           {
1048           case SBC_ARRAY:
1049           case SBC_PLAIN:
1050             {
1051               specifier *spec;
1052             
1053               for (spec = sbc->spec; spec; spec = spec->next)
1054                 {
1055                   if (spec->s == 0)
1056                     {
1057                       if (sbc->type == SBC_PLAIN)
1058                         dump (0, "long int %s%s;", st_lower (sbc->prefix),
1059                               spec->varname);
1060                       else if (f == 0)
1061                         {
1062                           dump (0, "int a_%s[%d];", 
1063                                 st_lower (sbc->name), sbc->narray);
1064                           f = 1;
1065                         }
1066                     }
1067                   else
1068                     dump_specifier_vars (spec, sbc);
1069                 }
1070             }
1071             break;
1072
1073           case SBC_VARLIST:
1074             dump (0, "int %sn_%s;", st_lower (sbc->prefix),
1075                   st_lower (sbc->name));
1076             dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
1077                   st_lower (sbc->name));
1078             break;
1079
1080           case SBC_VAR:
1081             dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
1082                   st_lower (sbc->name));
1083             break;
1084
1085           case SBC_STRING:
1086             dump (0, "char *s_%s;", st_lower (sbc->name));
1087             break;
1088
1089           case SBC_INT:
1090           case SBC_PINT:
1091             dump (0, "long n_%s;", st_lower (sbc->name));
1092             break;
1093
1094           case SBC_DBL:
1095             dump (0, "double n_%s;", st_lower (sbc->name));
1096             break;
1097
1098           default:;
1099             /* nothing */
1100           }
1101       }
1102
1103     dump (-1, "};");
1104     dump (-1, nullstr);
1105   }
1106
1107   /* Write out prototypes for custom_*() functions as necessary. */
1108   {
1109     int seen = 0;
1110     subcommand *sbc;
1111
1112     for (sbc = subcommands; sbc; sbc = sbc->next)
1113       if (sbc->type == SBC_CUSTOM)
1114         {
1115           if (!seen)
1116             {
1117               seen = 1;
1118               dump (0, "/* Prototype for custom subcommands of %s. */",
1119                     cmdname);
1120             }
1121           dump (0, "static int %scustom_%s (struct cmd_%s *);",
1122                 st_lower (prefix), st_lower (sbc->name),
1123                 make_identifier (cmdname));
1124         }
1125
1126     if (seen)
1127       dump (0, nullstr);
1128   }
1129
1130   /* Prototypes for parsing and freeing functions. */
1131   {
1132     dump (0, "/* Command parsing functions. */");
1133     dump (0, "static int parse_%s (struct cmd_%s *);",
1134           make_identifier (cmdname), make_identifier (cmdname));
1135     dump (0, "static void free_%s (struct cmd_%s *);",
1136           make_identifier (cmdname), make_identifier (cmdname));
1137     dump (0, nullstr);
1138   }
1139 }
1140
1141 /* Writes out code to initialize all the variables that need
1142    initialization for particular specifier SPEC inside subcommand SBC. */
1143 static void
1144 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1145 {
1146   if (spec->varname)
1147     {
1148       char s[256];
1149
1150       if (spec->def)
1151         sprintf (s, "%s%s",
1152                  st_upper (prefix), find_symbol (spec->def->con)->name);
1153       else
1154         strcpy (s, "-1");
1155       dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1156     }
1157   
1158   {
1159     setting *s;
1160
1161     for (s = spec->s; s; s = s->next)
1162       {
1163         if (s->value != VAL_NONE)
1164           {
1165             const char *init;
1166
1167             assert (s->value == VAL_INT || s->value == VAL_DBL);
1168             init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
1169
1170             dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1171           }
1172       }
1173   }
1174 }
1175
1176 /* Write code to initialize all variables. */
1177 static void
1178 dump_vars_init (void)
1179 {
1180   /* Loop through all the subcommands. */
1181   {
1182     subcommand *sbc;
1183
1184     for (sbc = subcommands; sbc; sbc = sbc->next)
1185       {
1186         int f = 0;
1187         
1188         dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1189         switch (sbc->type)
1190           {
1191           case SBC_DBL:
1192           case SBC_INT_LIST:
1193           case SBC_DBL_LIST:
1194           case SBC_CUSTOM:
1195             /* nothing */
1196             break;
1197             
1198           case SBC_PLAIN:
1199           case SBC_ARRAY:
1200             {
1201               specifier *spec;
1202             
1203               for (spec = sbc->spec; spec; spec = spec->next)
1204                 if (spec->s == NULL)
1205                   {
1206                     if (sbc->type == SBC_PLAIN)
1207                       dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1208                     else if (f == 0)
1209                       {
1210                         dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1211                               st_lower (sbc->name), st_lower (sbc->name));
1212                         f = 1;
1213                       }
1214                   }
1215                 else
1216                   dump_specifier_init (spec, sbc);
1217             }
1218             break;
1219
1220           case SBC_VARLIST:
1221             dump (0, "p->%sn_%s = 0;",
1222                   st_lower (sbc->prefix), st_lower (sbc->name));
1223             dump (0, "p->%sv_%s = NULL;",
1224                   st_lower (sbc->prefix), st_lower (sbc->name));
1225             break;
1226             
1227           case SBC_VAR:
1228             dump (0, "p->%sv_%s = NULL;",
1229                   st_lower (sbc->prefix), st_lower (sbc->name));
1230             break;
1231
1232           case SBC_STRING:
1233             dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1234             break;
1235
1236           case SBC_INT:
1237           case SBC_PINT:
1238             dump (0, "p->n_%s = NOT_LONG;", st_lower (sbc->name));
1239             break;
1240
1241           default:
1242             assert (0);
1243           }
1244       }
1245   }
1246 }
1247
1248 /* Return a pointer to a static buffer containing an expression that
1249    will match token T. */
1250 static char *
1251 make_match (const char *t)
1252 {
1253   char *s;
1254
1255   s = get_buffer ();
1256
1257   while (*t == '_')
1258     t++;
1259       
1260   if (is_keyword (t))
1261     sprintf (s, "lex_match (T_%s)", t);
1262   else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1263     strcpy (s, "(lex_match_id (\"ON\") || lex_match_id (\"YES\") "
1264             "|| lex_match_id (\"TRUE\"))");
1265   else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1266     strcpy (s, "(lex_match_id (\"OFF\") || lex_match_id (\"NO\") "
1267             "|| lex_match_id (\"FALSE\"))");
1268   else if (isdigit ((unsigned char) t[0]))
1269     sprintf (s, "lex_match_int (%s)", t);
1270   else
1271     sprintf (s, "lex_match_id (\"%s\")", t);
1272   
1273   return s;
1274 }
1275
1276 /* Write out the parsing code for specifier SPEC within subcommand
1277    SBC. */
1278 static void
1279 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1280 {
1281   setting *s;
1282
1283   if (spec->omit_kw && spec->omit_kw->next)
1284     error ("Omittable setting is not last setting in `%s' specifier.",
1285            spec->varname);
1286   if (spec->omit_kw && spec->omit_kw->parent->next)
1287     error ("Default specifier is not in last specifier in `%s' "
1288            "subcommand.", sbc->name);
1289   
1290   for (s = spec->s; s; s = s->next)
1291     {
1292       int first = spec == sbc->spec && s == spec->s;
1293
1294       /* Match the setting's keyword. */
1295       if (spec->omit_kw == s)
1296         {
1297           if (!first)
1298             {
1299               dump (1, "else");
1300               dump (1, "{");
1301             }
1302           dump (1, "%s;", make_match (s->specname));
1303         }
1304       else
1305         dump (1, "%sif (%s)", first ? "" : "else ",
1306               make_match (s->specname));
1307
1308       /* Handle values. */
1309       if (s->value == VAL_NONE)
1310         dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1311               st_upper (prefix), find_symbol (s->con)->name);
1312       else
1313         {
1314           if (spec->omit_kw != s)
1315             dump (1, "{");
1316           
1317           if (spec->varname)
1318             dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1319                   st_upper (prefix), find_symbol (s->con)->name);
1320           
1321           if (s->valtype == VT_PAREN)
1322             {
1323               if (s->optvalue)
1324                 {
1325                   dump (1, "if (lex_match ('('))");
1326                   dump (1, "{");
1327                 }
1328               else
1329                 {
1330                   dump (1, "if (!lex_match ('('))");
1331                   dump (1, "{");
1332                   dump (0, "msg (SE, _(\"`(' expected after %s "
1333                         "specifier of %s subcommand.\"));",
1334                         s->specname, sbc->name);
1335                   dump (0, "goto lossage;");
1336                   dump (-1, "}");
1337                   outdent ();
1338                 }
1339             }
1340
1341           if (s->value == VAL_INT)
1342             {
1343               dump (1, "if (!lex_integer_p ())");
1344               dump (1, "{");
1345               dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1346                     "requires an integer argument.\"));",
1347                     s->specname, sbc->name);
1348               dump (0, "goto lossage;");
1349               dump (-1, "}");
1350               dump (-1, "p->%s%s = lex_integer ();",
1351                     sbc->prefix, st_lower (s->valname));
1352             }
1353           else
1354             {
1355               dump (1, "if (token != T_NUM)");
1356               dump (1, "{");
1357               dump (0, "msg (SE, _(\"Number expected after %s "
1358                     "specifier of %s subcommand.\"));",
1359                     s->specname, sbc->name);
1360               dump (0, "goto lossage;");
1361               dump (-1, "}");
1362               dump (-1, "p->%s%s = tokval;", sbc->prefix,
1363                     st_lower (s->valname));
1364             }
1365           
1366           if (s->restriction)
1367             {
1368               {
1369                 char *str, *str2;
1370                 str = xmalloc (MAX_TOK_LEN);
1371                 str2 = xmalloc (MAX_TOK_LEN);
1372                 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1373                 sprintf (str, s->restriction, str2, str2, str2, str2,
1374                          str2, str2, str2, str2);
1375                 dump (1, "if (!(%s))", str);
1376                 free (str);
1377                 free (str2);
1378               }
1379               
1380               dump (1, "{");
1381               dump (0, "msg (SE, _(\"Bad argument for %s "
1382                     "specifier of %s subcommand.\"));",
1383                     s->specname, sbc->name);
1384               dump (0, "goto lossage;");
1385               dump (-1, "}");
1386               outdent ();
1387             }
1388           
1389           dump (0, "lex_get ();");
1390           
1391           if (s->valtype == VT_PAREN)
1392             {
1393               dump (1, "if (!lex_match (')'))");
1394               dump (1, "{");
1395               dump (0, "msg (SE, _(\"`)' expected after argument for "
1396                     "%s specifier of %s.\"));",
1397                     s->specname, sbc->name);
1398               dump (0, "goto lossage;");
1399               dump (-1, "}");
1400               outdent ();
1401               if (s->optvalue)
1402                 {
1403                   dump (-1, "}");
1404                   outdent ();
1405                 }
1406             }
1407           
1408           if (s != spec->omit_kw)
1409             dump (-1, "}");
1410         }
1411       
1412       if (s == spec->omit_kw)
1413         {
1414           dump (-1, "}");
1415           outdent ();
1416         }
1417       outdent ();
1418     }
1419 }
1420
1421 /* Write out the code to parse subcommand SBC. */
1422 static void
1423 dump_subcommand (const subcommand *sbc)
1424 {
1425   if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1426     {
1427       int count;
1428
1429       dump (1, "while (token != '/' && token != '.')");
1430       dump (1, "{");
1431       
1432       {
1433         specifier *spec;
1434
1435         for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1436           {
1437             if (spec->s)
1438               dump_specifier_parse (spec, sbc);
1439             else
1440               {
1441                 count++;
1442                 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1443                       make_match (st_upper (spec->varname)));
1444                 if (sbc->type == SBC_PLAIN)
1445                   dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1446                         spec->varname);
1447                 else
1448                   dump (0, "p->a_%s[%s%s%s] = 1;",
1449                         st_lower (sbc->name),
1450                         st_upper (prefix), st_upper (sbc->prefix),
1451                         st_upper (spec->varname));
1452                 outdent ();
1453               }
1454           }
1455       }
1456       
1457       {
1458         specifier *spec;
1459         setting *s;
1460
1461         /* This code first finds the last specifier in sbc.  Then it
1462            finds the last setting within that last specifier.  Either
1463            or both might be NULL. */
1464         spec = sbc->spec;
1465         s = NULL;
1466         if (spec)
1467           {
1468             while (spec->next)
1469               spec = spec->next;
1470             s = spec->s;
1471             if (s)
1472               while (s->next)
1473                 s = s->next;
1474           }
1475
1476         if (spec && (!spec->s || !spec->omit_kw))
1477           {
1478             dump (1, "else");
1479             dump (1, "{");
1480             dump (0, "lex_error (NULL);");
1481             dump (0, "goto lossage;");
1482             dump (-1, "}");
1483             outdent ();
1484           }
1485       }
1486
1487       dump (0, "lex_match (',');");
1488       dump (-1, "}");
1489       outdent ();
1490     }
1491   else if (sbc->type == SBC_VARLIST)
1492     {
1493       dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1494             "PV_APPEND%s%s))",
1495             st_lower (sbc->prefix), st_lower (sbc->name),
1496             st_lower (sbc->prefix), st_lower (sbc->name),
1497             sbc->message ? " |" : "",
1498             sbc->message ? sbc->message : "");
1499       dump (0, "goto lossage;");
1500       outdent ();
1501     }
1502   else if (sbc->type == SBC_VAR)
1503     {
1504       dump (0, "p->%sv_%s = parse_variable ();",
1505             st_lower (sbc->prefix), st_lower (sbc->name));
1506       dump (1, "if (p->%sv_%s)",
1507             st_lower (sbc->prefix), st_lower (sbc->name));
1508       dump (0, "goto lossage;");
1509       outdent ();
1510     }
1511   else if (sbc->type == SBC_STRING)
1512     {
1513       if (sbc->restriction)
1514         {
1515           dump (1, "{");
1516           dump (0, "int x;");
1517         }
1518       dump (1, "if (!lex_force_string ())");
1519       dump (0, "return 0;");
1520       outdent ();
1521       if (sbc->restriction)
1522         {
1523           dump (0, "x = ds_length (&tokstr);");
1524           dump (1, "if (!(%s))", sbc->restriction);
1525           dump (1, "{");
1526           dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1527                 sbc->name, sbc->message);
1528           dump (0, "goto lossage;");
1529           dump (-1, "}");
1530           outdent ();
1531         }
1532       dump (0, "p->s_%s = xstrdup (ds_value (&tokstr));",
1533             st_lower (sbc->name));
1534       dump (0, "lex_get ();");
1535       if (sbc->restriction)
1536         dump (-1, "}");
1537     }
1538   else if (sbc->type == SBC_DBL)
1539     {
1540       dump (1, "if (!lex_force_num ())");
1541       dump (0, "goto lossage;");
1542       dump (-1, "p->n_%s = lex_double ();", st_lower (sbc->name));
1543       dump (0, "lex_get();");
1544     }
1545   else if (sbc->type == SBC_INT)
1546     {
1547       dump (1, "if (!lex_force_int ())");
1548       dump (0, "goto lossage;");
1549       dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
1550       dump (0, "lex_get();");
1551     }
1552   else if (sbc->type == SBC_PINT)
1553     {
1554       dump (0, "lex_match ('(');");
1555       dump (1, "if (!lex_force_int ())");
1556       dump (0, "goto lossage;");
1557       dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
1558       dump (0, "lex_match (')');");
1559     }
1560   else if (sbc->type == SBC_CUSTOM)
1561     {
1562       dump (1, "switch (%scustom_%s (p))",
1563             st_lower (prefix), st_lower (sbc->name));
1564       dump (0, "{");
1565       dump (1, "case 0:");
1566       dump (0, "goto lossage;");
1567       dump (-1, "case 1:");
1568       indent ();
1569       dump (0, "break;");
1570       dump (-1, "case 2:");
1571       indent ();
1572       dump (0, "lex_error (NULL);");
1573       dump (0, "goto lossage;");
1574       dump (-1, "default:");
1575       indent ();
1576       dump (0, "assert (0);");
1577       dump (-1, "}");
1578       outdent ();
1579     }
1580 }
1581
1582 /* Write out entire parser. */
1583 static void
1584 dump_parser (void)
1585 {
1586   int f;
1587
1588   indent = 0;
1589
1590   dump (0, "static int");
1591   dump (0, "parse_%s (struct cmd_%s *p)", make_identifier (cmdname),
1592         make_identifier (cmdname));
1593   dump (1, "{");
1594
1595   dump_vars_init ();
1596
1597   dump (1, "for (;;)");
1598   dump (1, "{");
1599
1600   f = 0;
1601   if (def && (def->type == SBC_VARLIST))
1602     {
1603       if (def->type == SBC_VARLIST)
1604         dump (1, "if (token == T_ID "
1605               "&& dict_lookup_var (default_dict, tokid) != NULL "
1606               "&& lex_look_ahead () != '=')");
1607       else
1608         {
1609           dump (0, "if ((token == T_ID "
1610                 "&& dict_lookup_var (default_dict, tokid) "
1611                 "&& lex_look_ahead () != '=')");
1612           dump (1, "     || token == T_ALL)");
1613         }
1614       dump (1, "{");
1615       dump (0, "p->sbc_%s++;", st_lower (def->name));
1616       dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1617             "PV_APPEND))",
1618             st_lower (def->prefix), st_lower (def->name),
1619             st_lower (def->prefix), st_lower (def->name));
1620       dump (0, "goto lossage;");
1621       dump (-2, "}");
1622       outdent ();
1623       f = 1;
1624     }
1625   else if (def && def->type == SBC_CUSTOM)
1626     {
1627       dump (1, "switch (%scustom_%s (p))",
1628             st_lower (prefix), st_lower (def->name));
1629       dump (0, "{");
1630       dump (1, "case 0:");
1631       dump (0, "goto lossage;");
1632       dump (-1, "case 1:");
1633       indent ();
1634       dump (0, "p->sbc_%s++;", st_lower (def->name));
1635       dump (0, "continue;");
1636       dump (-1, "case 2:");
1637       indent ();
1638       dump (0, "break;");
1639       dump (-1, "default:");
1640       indent ();
1641       dump (0, "assert (0);");
1642       dump (-1, "}");
1643       outdent ();
1644     }
1645   
1646   {
1647     subcommand *sbc;
1648
1649     for (sbc = subcommands; sbc; sbc = sbc->next)
1650       {
1651         dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1652         f = 1;
1653         dump (1, "{");
1654
1655         dump (0, "lex_match ('=');");
1656         dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1657         if (sbc->once)
1658           {
1659             dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1660             dump (1, "{");
1661             dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
1662                   sbc->name);
1663             dump (0, "goto lossage;");
1664             dump (-1, "}");
1665             outdent ();
1666           }
1667         dump_subcommand (sbc);
1668         dump (-1, "}");
1669         outdent ();
1670       }
1671   }
1672   
1673   dump (1, "if (!lex_match ('/'))");
1674   dump (0, "break;");
1675   dump (-2, "}");
1676   outdent ();
1677   dump (0, nullstr);
1678   dump (1, "if (token != '.')");
1679   dump (1, "{");
1680   dump (0, "lex_error (_(\"expecting end of command\"));");
1681   dump (0, "goto lossage;");
1682   dump (-1, "}");
1683   dump (0, nullstr);
1684   dump (-1, "return 1;");
1685   dump (0, nullstr);
1686   dump (-1, "lossage:");
1687   indent ();
1688   dump (0, "free_%s (p);", make_identifier (cmdname));
1689   dump (0, "return 0;");
1690   dump (-1, "}");
1691   dump (0, nullstr);
1692 }
1693
1694 /* Write the output file header. */
1695 static void
1696 dump_header (void)
1697 {
1698   time_t curtime;
1699   struct tm *loctime;
1700   char *timep;
1701
1702   indent = 0;
1703   curtime = time (NULL);
1704   loctime = localtime (&curtime);
1705   timep = asctime (loctime);
1706   timep[strlen (timep) - 1] = 0;
1707   dump (0,   "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1708   dump (0, nullstr);
1709   dump (0, "   Generated by q2c from %s on %s.", ifn, timep);
1710   dump (0, "   Do not modify!");
1711   dump (0, " */");
1712   dump (0, nullstr);
1713 }
1714
1715 /* Write out commands to free variable state. */
1716 static void
1717 dump_free (void)
1718 {
1719   subcommand *sbc;
1720   int used;
1721
1722   indent = 0;
1723
1724   used = 0;
1725   for (sbc = subcommands; sbc; sbc = sbc->next)
1726     if (sbc->type == SBC_STRING)
1727       used = 1;
1728
1729   dump (0, "static void");
1730   dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1731         make_identifier (cmdname), used ? "" : " UNUSED");
1732   dump (1, "{");
1733
1734   for (sbc = subcommands; sbc; sbc = sbc->next)
1735     if (sbc->type == SBC_STRING)
1736       dump (0, "free (p->s_%s);", st_lower (sbc->name));
1737
1738   dump (-1, "}");
1739 }
1740
1741 /* Returns the name of a directive found on the current input line, if
1742    any, or a null pointer if none found. */
1743 static const char *
1744 recognize_directive (void)
1745 {
1746   static char directive[16];
1747   char *sp, *ep;
1748   
1749   sp = skip_ws (buf);
1750   if (strncmp (sp, "/*", 2))
1751     return NULL;
1752   sp = skip_ws (sp + 2);
1753   if (*sp != '(')
1754     return NULL;
1755   sp++;
1756
1757   ep = strchr (sp, ')');
1758   if (ep == NULL)
1759     return NULL;
1760
1761   if (ep - sp > 15)
1762     ep = sp + 15;
1763   memcpy (directive, sp, ep - sp);
1764   directive[ep - sp] = '\0';
1765   return directive;
1766 }
1767   
1768 int
1769 main (int argc, char *argv[])
1770 {
1771   pgmname = argv[0];
1772   if (argc != 3)
1773     fail ("Syntax: q2c input.q output.c");
1774
1775   ifn = argv[1];
1776   in = fopen (ifn, "r");
1777   if (!in)
1778     fail ("%s: open: %s.", ifn, strerror (errno));
1779
1780   ofn = argv[2];
1781   out = fopen (ofn, "w");
1782   if (!out)
1783     fail ("%s: open: %s.", ofn, strerror (errno));
1784
1785   is_open = 1;
1786   buf = xmalloc (MAX_LINE_LEN);
1787   tokstr = xmalloc (MAX_TOK_LEN);
1788
1789   dump_header ();
1790
1791   indent = 0;
1792   dump (0, "#line %d \"%s\"", ln + 1, ifn);
1793   while (get_line ())
1794     {
1795       const char *directive = recognize_directive ();
1796       if (directive == NULL)
1797         {
1798           dump (0, "%s", buf);
1799           continue;
1800         }
1801       
1802       dump (0, "#line %d \"%s\"", oln - 1, ofn);
1803       if (!strcmp (directive, "specification"))
1804         {
1805           /* Skip leading slash-star line. */
1806           get_line ();
1807           lex_get ();
1808
1809           parse ();
1810
1811           /* Skip trailing star-slash line. */
1812           get_line ();
1813         }
1814       else if (!strcmp (directive, "headers"))
1815         {
1816           indent = 0;
1817
1818           dump (0, "#include <assert.h>");
1819           dump (0, "#include <stdlib.h>");
1820           dump (0, "#include \"alloc.h\"");
1821           dump (0, "#include \"error.h\"");
1822           dump (0, "#include \"lexer.h\"");
1823           dump (0, "#include \"str.h\"");
1824           dump (0, "#include \"var.h\"");
1825           dump (0, nullstr);
1826         }
1827       else if (!strcmp (directive, "declarations"))
1828         dump_declarations ();
1829       else if (!strcmp (directive, "functions"))
1830         {
1831           dump_parser ();
1832           dump_free ();
1833         }
1834       else
1835         error ("unknown directive `%s'", directive);
1836       indent = 0;
1837       dump (0, "#line %d \"%s\"", ln + 1, ifn);
1838     }
1839
1840   return EXIT_SUCCESS;
1841 }
1842