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