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