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>.
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.
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.
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., 51 Franklin Street, Fifth Floor, Boston, MA
30 #include <libpspp/compiler.h>
31 #include <libpspp/str.h>
35 /* Max length of an input line. */
36 #define MAX_LINE_LEN 1024
38 /* Max token length. */
39 #define MAX_TOK_LEN 1024
44 /* Have the input and output files been opened yet? */
47 /* Input, output files. */
50 /* Input, output file names. */
53 /* Input, output file line number. */
56 /* Input line buffer, current position. */
62 T_STRING = 256, /* String literal. */
63 T_ID = 257 /* Identifier. */
66 /* Current token: either one of the above, or a single character. */
69 /* Token string value. */
72 /* Utility functions. */
76 /* Close all open files and delete the output file, on failure. */
85 if (remove (ofn) == -1)
86 fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
89 void hcf (void) NO_RETURN;
91 /* Terminate unsuccessfully. */
99 int fail (const char *, ...) PRINTF_FORMAT (1, 2);
100 int error (const char *, ...) PRINTF_FORMAT (1, 2);
102 /* Output an error message and terminate unsuccessfully. */
104 fail (const char *format, ...)
108 va_start (args, format);
109 fprintf (stderr, "%s: ", program_name);
110 vfprintf (stderr, format, args);
111 fprintf (stderr, "\n");
117 /* Output a context-dependent error message and terminate
120 error (const char *format,...)
124 va_start (args, format);
125 fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
126 vfprintf (stderr, format, args);
127 fprintf (stderr, "\n");
133 #define VME "virtual memory exhausted"
135 /* Allocate a block of SIZE bytes and return a pointer to its
138 xmalloc (size_t size)
147 fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
152 /* Make a dynamically allocated copy of string S and return a pointer
153 to the first character. */
155 xstrdup (const char *s)
161 size = strlen (s) + 1;
165 fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
171 /* Returns a pointer to one of 8 static buffers. The buffers are used
176 static char b[8][256];
185 /* Copies a string to a static buffer, converting it to lowercase in
186 the process, and returns a pointer to the static buffer. */
188 st_lower (const char *s)
192 p = cp = get_buffer ();
194 *cp++ = tolower ((unsigned char) (*s++));
200 /* Copies a string to a static buffer, converting it to uppercase in
201 the process, and returns a pointer to the static buffer. */
203 st_upper (const char *s)
207 p = cp = get_buffer ();
209 *cp++ = toupper ((unsigned char) (*s++));
215 /* Returns the address of the first non-whitespace character in S, or
216 the address of the null terminator if none. */
218 skip_ws (const char *s)
220 while (isspace ((unsigned char) *s))
225 /* Read one line from the input file into buf. Lines having special
226 formats are handled specially. */
231 if (0 == fgets (buf, MAX_LINE_LEN, in))
234 fail ("%s: fgets: %s", ifn, strerror (errno));
238 cp = strchr (buf, '\n');
246 /* Symbol table manager. */
248 /* Symbol table entry. */
249 typedef struct symbol symbol;
252 symbol *next; /* Next symbol in symbol table. */
253 char *name; /* Symbol name. */
254 int unique; /* 1=Name must be unique in this file. */
255 int ln; /* Line number of definition. */
256 int value; /* Symbol value. */
262 /* Add a symbol to the symbol table having name NAME, uniqueness
263 UNIQUE, and value VALUE. If a symbol having the same name is found
264 in the symbol table, its sequence number is returned and the symbol
265 table is not modified. Otherwise, the symbol is added and the next
266 available sequence number is returned. */
268 add_symbol (const char *name, int unique, int value)
273 sym = xmalloc (sizeof *sym);
274 sym->name = xstrdup (name);
275 sym->unique = unique;
288 if (!strcmp (iter->name, name))
292 fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
294 fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
311 /* Finds the symbol having given sequence number X within the symbol
312 table, and returns the associated symbol structure. */
319 while (x > 1 && iter)
329 /* Writes a printable representation of the current token to
337 printf ("STRING\t\"%s\"\n", tokstr);
340 printf ("ID\t%s\n", tokstr);
343 printf ("PUNCT\t%c\n", token);
346 #endif /* DUMP_TOKENS */
348 /* Reads a token from the input file. */
352 /* Skip whitespace and check for end of file. */
360 fail ("%s: Unexpected end of file.", ifn);
368 while (*cp != '"' && *cp)
374 error ("Unterminated string literal.");
382 error ("Unterminated string literal.");
385 else if (*cp == '_' || isalnum ((unsigned char) *cp))
389 while (*cp == '_' || isalnum ((unsigned char) *cp))
390 *dest++ = toupper ((unsigned char) (*cp++));
403 /* Force the current token to be an identifier token. */
408 error ("Identifier expected.");
411 /* Force the current token to be a string token. */
415 if (token != T_STRING)
416 error ("String expected.");
419 /* Checks whether the current token is the identifier S; if so, skips
420 the token and returns 1; otherwise, returns 0. */
422 match_id (const char *s)
424 if (token == T_ID && !strcmp (tokstr, s))
432 /* Checks whether the current token is T. If so, skips the token and
433 returns 1; otherwise, returns 0. */
445 /* Force the current token to be T, and skip it. */
450 error ("`%c' expected.", t);
456 /* Some specifiers have associated values. */
459 VAL_NONE, /* No value. */
460 VAL_INT, /* Integer value. */
461 VAL_DBL /* Floating point value. */
464 /* For those specifiers with values, the syntax of those values. */
467 VT_PLAIN, /* Unadorned value. */
468 VT_PAREN /* Value must be enclosed in parentheses. */
471 /* Forward definition. */
472 typedef struct specifier specifier;
474 /* A single setting. */
475 typedef struct setting setting;
478 specifier *parent; /* Owning specifier. */
479 setting *next; /* Next in the chain. */
480 char *specname; /* Name of the setting. */
481 int con; /* Sequence number. */
484 int valtype; /* One of VT_*. */
485 int value; /* One of VAL_*. */
486 int optvalue; /* 1=value is optional, 0=value is required. */
487 char *valname; /* Variable name for the value. */
488 char *restriction; /* !=NULL: expression specifying valid values. */
491 /* A single specifier. */
494 specifier *next; /* Next in the chain. */
495 char *varname; /* Variable name. */
496 setting *s; /* Associated settings. */
498 setting *def; /* Default setting. */
499 setting *omit_kw; /* Setting for which the keyword can be omitted. */
501 int index; /* Next array index. */
504 /* Subcommand types. */
507 SBC_PLAIN, /* The usual case. */
508 SBC_VARLIST, /* Variable list. */
509 SBC_INT, /* Integer value. */
510 SBC_PINT, /* Integer inside parentheses. */
511 SBC_DBL, /* Floating point value. */
512 SBC_INT_LIST, /* List of integers (?). */
513 SBC_DBL_LIST, /* List of floating points (?). */
514 SBC_CUSTOM, /* Custom. */
515 SBC_ARRAY, /* Array of boolean values. */
516 SBC_STRING, /* String value. */
517 SBC_VAR /* Single variable name. */
523 ARITY_ONCE_EXACTLY, /* must occur exactly once */
524 ARITY_ONCE_ONLY, /* zero or once */
525 ARITY_MANY /* 0, 1, ... , inf */
528 /* A single subcommand. */
529 typedef struct subcommand subcommand;
532 subcommand *next; /* Next in the chain. */
533 char *name; /* Subcommand name. */
534 subcommand_type type; /* One of SBC_*. */
535 subcommand_arity arity; /* How many times should the subcommand occur*/
536 int narray; /* Index of next array element. */
537 const char *prefix; /* Prefix for variable and constant names. */
538 specifier *spec; /* Array of specifiers. */
540 /* SBC_STRING and SBC_INT only. */
541 char *restriction; /* Expression restricting string length. */
542 char *message; /* Error message. */
543 int translatable; /* Error message is translatable */
546 /* Name of the command; i.e., DESCRIPTIVES. */
549 /* Short prefix for the command; i.e., `dsc_'. */
552 /* List of subcommands. */
553 subcommand *subcommands;
555 /* Default subcommand if any, or NULL. */
560 void parse_subcommands (void);
562 /* Parse an entire specification. */
566 /* Get the command name and prefix. */
567 if (token != T_STRING && token != T_ID)
568 error ("Command name expected.");
569 cmdname = xstrdup (tokstr);
573 prefix = xstrdup (tokstr);
578 /* Read all the subcommands. */
581 parse_subcommands ();
584 /* Parses a single setting into S, given subcommand information SBC
585 and specifier information SPEC. */
587 parse_setting (setting *s, specifier *spec)
591 if (match_token ('*'))
594 error ("Cannot have two settings with omittable keywords.");
599 if (match_token ('!'))
602 error ("Cannot have two default settings.");
608 s->specname = xstrdup (tokstr);
609 s->con = add_symbol (s->specname, 0, 0);
614 /* Parse setting value info if necessary. */
615 if (token != '/' && token != ';' && token != '.' && token != ',')
619 s->valtype = VT_PAREN;
623 s->valtype = VT_PLAIN;
625 s->optvalue = match_token ('*');
629 else if (match_id ("D"))
632 error ("`n' or `d' expected.");
637 s->valname = xstrdup (tokstr);
644 s->restriction = xstrdup (tokstr);
648 s->restriction = NULL;
650 if (s->valtype == VT_PAREN)
655 /* Parse a single specifier into SPEC, given subcommand information
658 parse_specifier (specifier *spec, subcommand *sbc)
663 spec->omit_kw = NULL;
664 spec->varname = NULL;
668 spec->varname = xstrdup (st_lower (tokstr));
672 /* Handle array elements. */
675 spec->index = sbc->narray;
676 if (sbc->type == SBC_ARRAY)
688 if ( sbc->type == SBC_ARRAY && token == T_ID )
690 spec->varname = xstrdup (st_lower (tokstr));
691 spec->index = sbc->narray;
697 /* Parse all the settings. */
699 setting **s = &spec->s;
703 *s = xmalloc (sizeof **s);
704 parse_setting (*s, spec);
705 if (token == ',' || token == ';' || token == '.')
714 /* Parse a list of specifiers for subcommand SBC. */
716 parse_specifiers (subcommand *sbc)
718 specifier **spec = &sbc->spec;
720 if (token == ';' || token == '.')
728 *spec = xmalloc (sizeof **spec);
729 parse_specifier (*spec, sbc);
730 if (token == ';' || token == '.')
733 spec = &(*spec)->next;
735 (*spec)->next = NULL;
738 /* Parse a subcommand into SBC. */
740 parse_subcommand (subcommand *sbc)
742 if (match_token ('*'))
745 error ("Multiple default subcommands.");
749 sbc->arity = ARITY_ONCE_ONLY;
750 if ( match_token('+'))
751 sbc->arity = ARITY_MANY;
752 else if (match_token('^'))
753 sbc->arity = ARITY_ONCE_EXACTLY ;
757 sbc->name = xstrdup (tokstr);
761 sbc->type = SBC_PLAIN;
763 sbc->translatable = 0;
765 if (match_token ('['))
768 sbc->prefix = xstrdup (st_lower (tokstr));
774 sbc->type = SBC_ARRAY;
775 parse_specifiers (sbc);
780 if (match_token ('('))
783 sbc->prefix = xstrdup (st_lower (tokstr));
793 if (match_id ("VAR"))
795 if (match_id ("VARLIST"))
797 if (match_token ('('))
800 sbc->message = xstrdup (tokstr);
805 else sbc->message = NULL;
807 sbc->type = SBC_VARLIST;
809 else if (match_id ("INTEGER"))
811 sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
812 if ( token == T_STRING)
814 sbc->restriction = xstrdup (tokstr);
816 if ( match_id("N_") )
822 sbc->translatable = 1;
828 sbc->message = xstrdup (tokstr);
831 sbc->restriction = NULL;
833 else if (match_id ("PINT"))
834 sbc->type = SBC_PINT;
835 else if (match_id ("DOUBLE"))
837 if ( match_id ("LIST") )
838 sbc->type = SBC_DBL_LIST;
842 else if (match_id ("STRING"))
844 sbc->type = SBC_STRING;
845 if (token == T_STRING)
847 sbc->restriction = xstrdup (tokstr);
850 sbc->message = xstrdup (tokstr);
854 sbc->restriction = NULL;
856 else if (match_id ("CUSTOM"))
857 sbc->type = SBC_CUSTOM;
859 parse_specifiers (sbc);
863 /* Parse all the subcommands. */
865 parse_subcommands (void)
867 subcommand **sbc = &subcommands;
871 *sbc = xmalloc (sizeof **sbc);
874 parse_subcommand (*sbc);
886 #define BASE_INDENT 2 /* Starting indent. */
887 #define INC_INDENT 2 /* Indent increment. */
889 /* Increment the indent. */
890 #define indent() indent += INC_INDENT
891 #define outdent() indent -= INC_INDENT
893 /* Size of the indent from the left margin. */
896 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
898 /* Write line FORMAT to the output file, formatted as with printf,
899 indented `indent' characters from the left margin. If INDENTION is
900 greater than 0, indents BASE_INDENT * INDENTION characters after
901 writing the line; if INDENTION is less than 0, dedents BASE_INDENT
902 * INDENTION characters _before_ writing the line. */
904 dump (int indention, const char *format, ...)
910 indent += BASE_INDENT * indention;
913 va_start (args, format);
914 for (i = 0; i < indent; i++)
916 vfprintf (out, format, args);
921 indent += BASE_INDENT * indention;
924 /* Write the structure members for specifier SPEC to the output file.
925 SBC is the including subcommand. */
927 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
930 dump (0, "long %s%s;", sbc->prefix, spec->varname);
935 for (s = spec->s; s; s = s->next)
937 if (s->value != VAL_NONE)
939 const char *typename;
941 assert (s->value == VAL_INT || s->value == VAL_DBL);
942 typename = s->value == VAL_INT ? "long" : "double";
944 dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
950 /* Returns 1 if string T is a PSPP keyword, 0 otherwise. */
952 is_keyword (const char *t)
954 static const char *kw[] =
956 "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
957 "NE", "ALL", "BY", "TO", "WITH", 0,
961 for (cp = kw; *cp; cp++)
962 if (!strcmp (t, *cp))
967 /* Transforms a string NAME into a valid C identifier: makes
968 everything lowercase and maps nonalphabetic characters to
969 underscores. Returns a pointer to a static buffer. */
971 make_identifier (const char *name)
973 char *p = get_buffer ();
976 for (cp = p; *name; name++)
977 if (isalpha ((unsigned char) *name))
978 *cp++ = tolower ((unsigned char) (*name));
986 /* Writes the struct and enum declarations for the parser. */
988 dump_declarations (void)
992 /* Write out enums for all the identifiers in the symbol table. */
998 /* Note the squirmings necessary to make sure that the last enum
999 is not followed by a comma, as mandated by ANSI C89. */
1000 for (sym = symtab, f = k = 0; sym; sym = sym->next)
1001 if (!sym->unique && !is_keyword (sym->name))
1005 dump (0, "/* Settings for subcommand specifiers. */");
1012 buf = xmalloc (1024);
1017 sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
1021 sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
1026 buf[strlen (buf) - 1] = 0;
1037 /* Write out some type definitions */
1039 dump (0, "#define MAXLISTS 10");
1043 /* For every array subcommand, write out the associated enumerated
1048 for (sbc = subcommands; sbc; sbc = sbc->next)
1049 if (sbc->type == SBC_ARRAY && sbc->narray)
1051 dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1059 for (spec = sbc->spec; spec; spec = spec->next)
1060 dump (0, "%s%s%s = %d,",
1061 st_upper (prefix), st_upper (sbc->prefix),
1062 st_upper (spec->varname), spec->index);
1064 dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1072 /* Write out structure declaration. */
1076 dump (0, "/* %s structure. */", cmdname);
1077 dump (1, "struct cmd_%s", make_identifier (cmdname));
1079 for (sbc = subcommands; sbc; sbc = sbc->next)
1083 if (sbc != subcommands)
1086 dump (0, "/* %s subcommand. */", sbc->name);
1087 dump (0, "int sbc_%s;", st_lower (sbc->name));
1096 for (spec = sbc->spec; spec; spec = spec->next)
1100 if (sbc->type == SBC_PLAIN)
1101 dump (0, "long int %s%s;", st_lower (sbc->prefix),
1105 dump (0, "int a_%s[%s%scount];",
1106 st_lower (sbc->name),
1108 st_upper (sbc->prefix)
1115 dump_specifier_vars (spec, sbc);
1121 dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
1122 st_lower (sbc->name));
1123 dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
1124 st_lower (sbc->name));
1128 dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
1129 st_lower (sbc->name));
1133 dump (0, "char *s_%s;", st_lower (sbc->name));
1138 dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
1142 dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
1146 dump (0, "subc_list_double dl_%s[MAXLISTS];",
1147 st_lower(sbc->name));
1151 dump (0, "subc_list_int il_%s[MAXLISTS];",
1152 st_lower(sbc->name));
1165 /* Write out prototypes for custom_*() functions as necessary. */
1170 for (sbc = subcommands; sbc; sbc = sbc->next)
1171 if (sbc->type == SBC_CUSTOM)
1176 dump (0, "/* Prototype for custom subcommands of %s. */",
1179 dump (0, "static int %scustom_%s (struct cmd_%s *, void *);",
1180 st_lower (prefix), st_lower (sbc->name),
1181 make_identifier (cmdname));
1188 /* Prototypes for parsing and freeing functions. */
1190 dump (0, "/* Command parsing functions. */");
1191 dump (0, "static int parse_%s (struct cmd_%s *, void *);",
1192 make_identifier (cmdname), make_identifier (cmdname));
1193 dump (0, "static void free_%s (struct cmd_%s *);",
1194 make_identifier (cmdname), make_identifier (cmdname));
1199 /* Writes out code to initialize all the variables that need
1200 initialization for particular specifier SPEC inside subcommand SBC. */
1202 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1210 st_upper (prefix), find_symbol (spec->def->con)->name);
1213 dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1219 for (s = spec->s; s; s = s->next)
1221 if (s->value != VAL_NONE)
1225 assert (s->value == VAL_INT || s->value == VAL_DBL);
1226 init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
1228 dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1234 /* Write code to initialize all variables. */
1236 dump_vars_init (int persistent)
1238 /* Loop through all the subcommands. */
1242 for (sbc = subcommands; sbc; sbc = sbc->next)
1246 dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1257 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1258 dump (0, "subc_list_double_create(&p->dl_%s[i]) ;",
1259 st_lower (sbc->name)
1267 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1268 dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
1281 for (spec = sbc->spec; spec; spec = spec->next)
1282 if (spec->s == NULL)
1284 if (sbc->type == SBC_PLAIN)
1285 dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1288 dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1289 st_lower (sbc->name), st_lower (sbc->name));
1294 dump_specifier_init (spec, sbc);
1299 dump (0, "p->%sn_%s = 0;",
1300 st_lower (sbc->prefix), st_lower (sbc->name));
1301 dump (0, "p->%sv_%s = NULL;",
1302 st_lower (sbc->prefix), st_lower (sbc->name));
1306 dump (0, "p->%sv_%s = NULL;",
1307 st_lower (sbc->prefix), st_lower (sbc->name));
1311 dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1318 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1319 dump (0, "p->n_%s[i] = NOT_LONG;", st_lower (sbc->name));
1331 /* Return a pointer to a static buffer containing an expression that
1332 will match token T. */
1334 make_match (const char *t)
1344 sprintf (s, "lex_match (T_%s)", t);
1345 else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1346 strcpy (s, "(lex_match_id (\"ON\") || lex_match_id (\"YES\") "
1347 "|| lex_match_id (\"TRUE\"))");
1348 else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1349 strcpy (s, "(lex_match_id (\"OFF\") || lex_match_id (\"NO\") "
1350 "|| lex_match_id (\"FALSE\"))");
1351 else if (isdigit ((unsigned char) t[0]))
1352 sprintf (s, "lex_match_int (%s)", t);
1354 sprintf (s, "lex_match_id (\"%s\")", t);
1359 /* Write out the parsing code for specifier SPEC within subcommand
1362 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1366 if (spec->omit_kw && spec->omit_kw->next)
1367 error ("Omittable setting is not last setting in `%s' specifier.",
1369 if (spec->omit_kw && spec->omit_kw->parent->next)
1370 error ("Default specifier is not in last specifier in `%s' "
1371 "subcommand.", sbc->name);
1373 for (s = spec->s; s; s = s->next)
1375 int first = spec == sbc->spec && s == spec->s;
1377 /* Match the setting's keyword. */
1378 if (spec->omit_kw == s)
1385 dump (1, "%s;", make_match (s->specname));
1388 dump (1, "%sif (%s)", first ? "" : "else ",
1389 make_match (s->specname));
1392 /* Handle values. */
1393 if (s->value == VAL_NONE)
1394 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1395 st_upper (prefix), find_symbol (s->con)->name);
1398 if (spec->omit_kw != s)
1403 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1404 st_upper (prefix), find_symbol (s->con)->name);
1406 if ( sbc->type == SBC_ARRAY )
1407 dump (0, "p->a_%s[%s%s%s] = 1;",
1408 st_lower (sbc->name),
1409 st_upper (prefix), st_upper (sbc->prefix),
1410 st_upper (spec->varname));
1414 if (s->valtype == VT_PAREN)
1418 dump (1, "if (lex_match ('('))");
1423 dump (1, "if (!lex_match ('('))");
1425 dump (0, "msg (SE, _(\"`(' expected after %s "
1426 "specifier of %s subcommand.\"));",
1427 s->specname, sbc->name);
1428 dump (0, "goto lossage;");
1434 if (s->value == VAL_INT)
1436 dump (1, "if (!lex_is_integer ())");
1438 dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1439 "requires an integer argument.\"));",
1440 s->specname, sbc->name);
1441 dump (0, "goto lossage;");
1443 dump (-1, "p->%s%s = lex_integer ();",
1444 sbc->prefix, st_lower (s->valname));
1448 dump (1, "if (!lex_is_number ())");
1450 dump (0, "msg (SE, _(\"Number expected after %s "
1451 "specifier of %s subcommand.\"));",
1452 s->specname, sbc->name);
1453 dump (0, "goto lossage;");
1455 dump (-1, "p->%s%s = tokval;", sbc->prefix,
1456 st_lower (s->valname));
1463 str = xmalloc (MAX_TOK_LEN);
1464 str2 = xmalloc (MAX_TOK_LEN);
1465 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1466 sprintf (str, s->restriction, str2, str2, str2, str2,
1467 str2, str2, str2, str2);
1468 dump (1, "if (!(%s))", str);
1474 dump (0, "msg (SE, _(\"Bad argument for %s "
1475 "specifier of %s subcommand.\"));",
1476 s->specname, sbc->name);
1477 dump (0, "goto lossage;");
1482 dump (0, "lex_get ();");
1484 if (s->valtype == VT_PAREN)
1486 dump (1, "if (!lex_match (')'))");
1488 dump (0, "msg (SE, _(\"`)' expected after argument for "
1489 "%s specifier of %s.\"));",
1490 s->specname, sbc->name);
1491 dump (0, "goto lossage;");
1501 if (s != spec->omit_kw)
1505 if (s == spec->omit_kw)
1514 /* Write out the code to parse subcommand SBC. */
1516 dump_subcommand (const subcommand *sbc)
1518 if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1522 dump (1, "while (token != '/' && token != '.')");
1528 for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1531 dump_specifier_parse (spec, sbc);
1535 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1536 make_match (st_upper (spec->varname)));
1537 if (sbc->type == SBC_PLAIN)
1538 dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1541 dump (0, "p->a_%s[%s%s%s] = 1;",
1542 st_lower (sbc->name),
1543 st_upper (prefix), st_upper (sbc->prefix),
1544 st_upper (spec->varname));
1554 /* This code first finds the last specifier in sbc. Then it
1555 finds the last setting within that last specifier. Either
1556 or both might be NULL. */
1569 if (spec && (!spec->s || !spec->omit_kw))
1573 dump (0, "lex_error (NULL);");
1574 dump (0, "goto lossage;");
1580 dump (0, "lex_match (',');");
1584 else if (sbc->type == SBC_VARLIST)
1586 dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1588 st_lower (sbc->prefix), st_lower (sbc->name),
1589 st_lower (sbc->prefix), st_lower (sbc->name),
1590 sbc->message ? " |" : "",
1591 sbc->message ? sbc->message : "");
1592 dump (0, "goto lossage;");
1595 else if (sbc->type == SBC_VAR)
1597 dump (0, "p->%sv_%s = parse_variable ();",
1598 st_lower (sbc->prefix), st_lower (sbc->name));
1599 dump (1, "if (!p->%sv_%s)",
1600 st_lower (sbc->prefix), st_lower (sbc->name));
1601 dump (0, "goto lossage;");
1604 else if (sbc->type == SBC_STRING)
1606 if (sbc->restriction)
1611 dump (1, "if (!lex_force_string ())");
1612 dump (0, "return 0;");
1614 if (sbc->restriction)
1616 dump (0, "x = ds_length (&tokstr);");
1617 dump (1, "if (!(%s))", sbc->restriction);
1619 dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1620 sbc->name, sbc->message);
1621 dump (0, "goto lossage;");
1625 dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1626 dump (0, "p->s_%s = ds_xstrdup (&tokstr);",
1627 st_lower (sbc->name));
1628 dump (0, "lex_get ();");
1629 if (sbc->restriction)
1632 else if (sbc->type == SBC_DBL)
1634 dump (1, "if (!lex_force_num ())");
1635 dump (0, "goto lossage;");
1636 dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number ();",
1637 st_lower (sbc->name), st_lower (sbc->name) );
1638 dump (0, "lex_get();");
1640 else if (sbc->type == SBC_INT)
1644 dump (1, "if (!lex_force_int ())");
1645 dump (0, "goto lossage;");
1646 dump (-1, "x = lex_integer ();");
1647 dump (0, "lex_get();");
1648 if (sbc->restriction)
1651 dump (1, "if (!(%s))", sbc->restriction);
1653 sprintf(buf,sbc->message,sbc->name);
1654 if ( sbc->translatable )
1655 dump (0, "msg (SE, gettext(\"%s\"));",buf);
1657 dump (0, "msg (SE, \"%s\");",buf);
1658 dump (0, "goto lossage;");
1661 dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1664 else if (sbc->type == SBC_PINT)
1666 dump (0, "lex_match ('(');");
1667 dump (1, "if (!lex_force_int ())");
1668 dump (0, "goto lossage;");
1669 dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
1670 dump (0, "lex_match (')');");
1672 else if (sbc->type == SBC_DBL_LIST)
1674 dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1676 dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1677 dump (0, "goto lossage;");
1680 dump (1, "while (token != '/' && token != '.')");
1682 dump (0, "lex_match(',');");
1683 dump (0, "if (!lex_force_num ())");
1685 dump (0, "goto lossage;");
1688 dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_number ());",
1689 st_lower (sbc->name),st_lower (sbc->name)
1692 dump (0, "lex_get();");
1696 else if (sbc->type == SBC_CUSTOM)
1698 dump (1, "switch (%scustom_%s (p, aux))",
1699 st_lower (prefix), st_lower (sbc->name));
1701 dump (1, "case 0:");
1702 dump (0, "goto lossage;");
1703 dump (-1, "case 1:");
1706 dump (-1, "case 2:");
1708 dump (0, "lex_error (NULL);");
1709 dump (0, "goto lossage;");
1710 dump (-1, "default:");
1712 dump (0, "assert (0);");
1718 /* Write out entire parser. */
1720 dump_parser (int persistent)
1726 dump (0, "static int");
1727 dump (0, "parse_%s (struct cmd_%s *p, void *aux UNUSED)",
1728 make_identifier (cmdname),
1729 make_identifier (cmdname));
1732 dump_vars_init (persistent);
1734 dump (1, "for (;;)");
1738 if (def && (def->type == SBC_VARLIST))
1740 if (def->type == SBC_VARLIST)
1741 dump (1, "if (token == T_ID "
1742 "&& dict_lookup_var (default_dict, tokid) != NULL "
1743 "&& lex_look_ahead () != '=')");
1746 dump (0, "if ((token == T_ID "
1747 "&& dict_lookup_var (default_dict, tokid) "
1748 "&& lex_look_ahead () != '=')");
1749 dump (1, " || token == T_ALL)");
1752 dump (0, "p->sbc_%s++;", st_lower (def->name));
1753 dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1755 st_lower (def->prefix), st_lower (def->name),
1756 st_lower (def->prefix), st_lower (def->name));
1757 dump (0, "goto lossage;");
1762 else if (def && def->type == SBC_CUSTOM)
1764 dump (1, "switch (%scustom_%s (p, aux))",
1765 st_lower (prefix), st_lower (def->name));
1767 dump (1, "case 0:");
1768 dump (0, "goto lossage;");
1769 dump (-1, "case 1:");
1771 dump (0, "p->sbc_%s++;", st_lower (def->name));
1772 dump (0, "continue;");
1773 dump (-1, "case 2:");
1776 dump (-1, "default:");
1778 dump (0, "assert (0);");
1786 for (sbc = subcommands; sbc; sbc = sbc->next)
1788 dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1792 dump (0, "lex_match ('=');");
1793 dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1794 if (sbc->arity != ARITY_MANY)
1796 dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1798 dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
1800 dump (0, "goto lossage;");
1804 dump_subcommand (sbc);
1811 /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1812 dump(1,"else if ( get_syntax() != COMPATIBLE && lex_match_id(\"ALGORITHM\"))");
1815 dump (0, "lex_match ('=');");
1817 dump(1,"if (lex_match_id(\"COMPATIBLE\"))");
1818 dump(0,"set_cmd_algorithm(COMPATIBLE);");
1820 dump(1,"else if (lex_match_id(\"ENHANCED\"))");
1821 dump(0,"set_cmd_algorithm(ENHANCED);");
1828 dump (1, "if (!lex_match ('/'))");
1833 dump (1, "if (token != '.')");
1835 dump (0, "lex_error (_(\"expecting end of command\"));");
1836 dump (0, "goto lossage;");
1843 /* Check that mandatory subcommands have been specified */
1846 for (sbc = subcommands; sbc; sbc = sbc->next)
1849 if ( sbc->arity == ARITY_ONCE_EXACTLY )
1851 dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1853 dump (0, "msg (SE, _(\"%s subcommand must be given.\"));",
1855 dump (0, "goto lossage;");
1862 dump (-1, "return 1;");
1864 dump (-1, "lossage:");
1866 dump (0, "free_%s (p);", make_identifier (cmdname));
1867 dump (0, "return 0;");
1873 /* Write the output file header. */
1882 curtime = time (NULL);
1883 loctime = localtime (&curtime);
1884 timep = asctime (loctime);
1885 timep[strlen (timep) - 1] = 0;
1886 dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1888 dump (0, " Generated by q2c from %s on %s.", ifn, timep);
1889 dump (0, " Do not modify!");
1893 /* Write out commands to free variable state. */
1895 dump_free (int persistent)
1905 for (sbc = subcommands; sbc; sbc = sbc->next)
1907 if (sbc->type == SBC_STRING)
1909 if (sbc->type == SBC_DBL_LIST)
1915 dump (0, "static void");
1916 dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1917 make_identifier (cmdname), used ? "" : " UNUSED");
1923 for (sbc = subcommands; sbc; sbc = sbc->next)
1928 dump (0, "free (p->v_%s);", st_lower (sbc->name));
1931 dump (0, "free (p->s_%s);", st_lower (sbc->name));
1936 dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
1937 dump (1, "subc_list_double_destroy(&p->dl_%s[i]);", st_lower (sbc->name));
1953 /* Returns the name of a directive found on the current input line, if
1954 any, or a null pointer if none found. */
1956 recognize_directive (void)
1958 static char directive[16];
1962 if (strncmp (sp, "/*", 2))
1964 sp = skip_ws (sp + 2);
1969 ep = strchr (sp, ')');
1975 memcpy (directive, sp, ep - sp);
1976 directive[ep - sp] = '\0';
1981 main (int argc, char *argv[])
1983 program_name = argv[0];
1985 fail ("Syntax: q2c input.q output.c");
1988 in = fopen (ifn, "r");
1990 fail ("%s: open: %s.", ifn, strerror (errno));
1993 out = fopen (ofn, "w");
1995 fail ("%s: open: %s.", ofn, strerror (errno));
1998 buf = xmalloc (MAX_LINE_LEN);
1999 tokstr = xmalloc (MAX_TOK_LEN);
2005 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2008 const char *directive = recognize_directive ();
2009 if (directive == NULL)
2011 dump (0, "%s", buf);
2015 dump (0, "#line %d \"%s\"", oln + 1, ofn);
2016 if (!strcmp (directive, "specification"))
2018 /* Skip leading slash-star line. */
2024 /* Skip trailing star-slash line. */
2027 else if (!strcmp (directive, "headers"))
2031 dump (0, "#include <stdlib.h>");
2032 dump (0, "#include <libpspp/alloc.h>");
2033 dump (0, "#include <libpspp/message.h>");
2034 dump (0, "#include <language/lexer/lexer.h>");
2035 dump (0, "#include <language/lexer/variable-parser.h>");
2036 dump (0, "#include <data/settings.h>");
2037 dump (0, "#include <libpspp/str.h>");
2038 dump (0, "#include <language/lexer/subcommand-list.h>");
2039 dump (0, "#include <data/variable.h>");
2042 dump (0, "#include \"gettext.h\"");
2043 dump (0, "#define _(msgid) gettext (msgid)");
2046 else if (!strcmp (directive, "declarations"))
2047 dump_declarations ();
2048 else if (!strcmp (directive, "functions"))
2053 else if (!strcmp (directive, "_functions"))
2059 error ("unknown directive `%s'", directive);
2061 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2066 return EXIT_SUCCESS;