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