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 sbc->arity = ARITY_MANY;
744 if (match_token ('*'))
747 error ("Multiple default subcommands.");
751 if ( match_token('+'))
752 sbc->arity = ARITY_ONCE_ONLY ;
753 else if (match_token('^'))
754 sbc->arity = ARITY_ONCE_EXACTLY ;
758 sbc->name = xstrdup (tokstr);
762 sbc->type = SBC_PLAIN;
764 sbc->translatable = 0;
766 if (match_token ('['))
769 sbc->prefix = xstrdup (st_lower (tokstr));
775 sbc->type = SBC_ARRAY;
776 parse_specifiers (sbc);
781 if (match_token ('('))
784 sbc->prefix = xstrdup (st_lower (tokstr));
794 if (match_id ("VAR"))
796 if (match_id ("VARLIST"))
798 if (match_token ('('))
801 sbc->message = xstrdup (tokstr);
806 else sbc->message = NULL;
808 sbc->type = SBC_VARLIST;
810 else if (match_id ("INTEGER"))
812 sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
813 if ( token == T_STRING)
815 sbc->restriction = xstrdup (tokstr);
817 if ( match_id("N_") )
823 sbc->translatable = 1;
829 sbc->message = xstrdup (tokstr);
832 sbc->restriction = NULL;
834 else if (match_id ("PINT"))
835 sbc->type = SBC_PINT;
836 else if (match_id ("DOUBLE"))
838 if ( match_id ("LIST") )
839 sbc->type = SBC_DBL_LIST;
843 else if (match_id ("STRING"))
845 sbc->type = SBC_STRING;
846 if (token == T_STRING)
848 sbc->restriction = xstrdup (tokstr);
851 sbc->message = xstrdup (tokstr);
855 sbc->restriction = NULL;
857 else if (match_id ("CUSTOM"))
858 sbc->type = SBC_CUSTOM;
860 parse_specifiers (sbc);
864 /* Parse all the subcommands. */
866 parse_subcommands (void)
868 subcommand **sbc = &subcommands;
872 *sbc = xmalloc (sizeof **sbc);
875 parse_subcommand (*sbc);
887 #define BASE_INDENT 2 /* Starting indent. */
888 #define INC_INDENT 2 /* Indent increment. */
890 /* Increment the indent. */
891 #define indent() indent += INC_INDENT
892 #define outdent() indent -= INC_INDENT
894 /* Size of the indent from the left margin. */
897 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
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. */
905 dump (int indention, const char *format, ...)
911 indent += BASE_INDENT * indention;
914 va_start (args, format);
915 for (i = 0; i < indent; i++)
917 vfprintf (out, format, args);
922 indent += BASE_INDENT * indention;
925 /* Write the structure members for specifier SPEC to the output file.
926 SBC is the including subcommand. */
928 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
931 dump (0, "long %s%s;", sbc->prefix, spec->varname);
936 for (s = spec->s; s; s = s->next)
938 if (s->value != VAL_NONE)
940 const char *typename;
942 assert (s->value == VAL_INT || s->value == VAL_DBL);
943 typename = s->value == VAL_INT ? "long" : "double";
945 dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
951 /* Returns 1 if string T is a PSPP keyword, 0 otherwise. */
953 is_keyword (const char *t)
955 static const char *kw[] =
957 "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
958 "NE", "ALL", "BY", "TO", "WITH", 0,
962 for (cp = kw; *cp; cp++)
963 if (!strcmp (t, *cp))
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. */
972 make_identifier (const char *name)
974 char *p = get_buffer ();
977 for (cp = p; *name; name++)
978 if (isalpha ((unsigned char) *name))
979 *cp++ = tolower ((unsigned char) (*name));
987 /* Writes the struct and enum declarations for the parser. */
989 dump_declarations (void)
993 /* Write out enums for all the identifiers in the symbol table. */
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))
1006 dump (0, "/* Settings for subcommand specifiers. */");
1013 buf = xmalloc (1024);
1018 sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
1022 sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
1027 buf[strlen (buf) - 1] = 0;
1038 /* Write out some type definitions */
1040 dump (0, "#define MAXLISTS 10");
1044 /* For every array subcommand, write out the associated enumerated
1049 for (sbc = subcommands; sbc; sbc = sbc->next)
1050 if (sbc->type == SBC_ARRAY && sbc->narray)
1052 dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1060 for (spec = sbc->spec; spec; spec = spec->next)
1061 dump (0, "%s%s%s = %d,",
1062 st_upper (prefix), st_upper (sbc->prefix),
1063 st_upper (spec->varname), spec->index);
1065 dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1073 /* Write out structure declaration. */
1077 dump (0, "/* %s structure. */", cmdname);
1078 dump (1, "struct cmd_%s", make_identifier (cmdname));
1080 for (sbc = subcommands; sbc; sbc = sbc->next)
1084 if (sbc != subcommands)
1087 dump (0, "/* %s subcommand. */", sbc->name);
1088 dump (0, "int sbc_%s;", st_lower (sbc->name));
1097 for (spec = sbc->spec; spec; spec = spec->next)
1101 if (sbc->type == SBC_PLAIN)
1102 dump (0, "long int %s%s;", st_lower (sbc->prefix),
1106 dump (0, "int a_%s[%s%scount];",
1107 st_lower (sbc->name),
1109 st_upper (sbc->prefix)
1116 dump_specifier_vars (spec, sbc);
1122 dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
1123 st_lower (sbc->name));
1124 dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
1125 st_lower (sbc->name));
1129 dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
1130 st_lower (sbc->name));
1134 dump (0, "char *s_%s;", st_lower (sbc->name));
1139 dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
1143 dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
1147 dump (0, "subc_list_double dl_%s[MAXLISTS];",
1148 st_lower(sbc->name));
1152 dump (0, "subc_list_int il_%s[MAXLISTS];",
1153 st_lower(sbc->name));
1166 /* Write out prototypes for custom_*() functions as necessary. */
1171 for (sbc = subcommands; sbc; sbc = sbc->next)
1172 if (sbc->type == SBC_CUSTOM)
1177 dump (0, "/* Prototype for custom subcommands of %s. */",
1180 dump (0, "static int %scustom_%s (struct cmd_%s *);",
1181 st_lower (prefix), st_lower (sbc->name),
1182 make_identifier (cmdname));
1189 /* Prototypes for parsing and freeing functions. */
1191 dump (0, "/* Command parsing functions. */");
1192 dump (0, "static int parse_%s (struct cmd_%s *);",
1193 make_identifier (cmdname), make_identifier (cmdname));
1194 dump (0, "static void free_%s (struct cmd_%s *);",
1195 make_identifier (cmdname), make_identifier (cmdname));
1200 /* Writes out code to initialize all the variables that need
1201 initialization for particular specifier SPEC inside subcommand SBC. */
1203 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1211 st_upper (prefix), find_symbol (spec->def->con)->name);
1214 dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1220 for (s = spec->s; s; s = s->next)
1222 if (s->value != VAL_NONE)
1226 assert (s->value == VAL_INT || s->value == VAL_DBL);
1227 init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
1229 dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1235 /* Write code to initialize all variables. */
1237 dump_vars_init (int persistent)
1239 /* Loop through all the subcommands. */
1243 for (sbc = subcommands; sbc; sbc = sbc->next)
1247 dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1258 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1259 dump (0, "subc_list_double_create(&p->dl_%s[i]) ;",
1260 st_lower (sbc->name)
1268 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1269 dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
1282 for (spec = sbc->spec; spec; spec = spec->next)
1283 if (spec->s == NULL)
1285 if (sbc->type == SBC_PLAIN)
1286 dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1289 dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1290 st_lower (sbc->name), st_lower (sbc->name));
1295 dump_specifier_init (spec, sbc);
1300 dump (0, "p->%sn_%s = 0;",
1301 st_lower (sbc->prefix), st_lower (sbc->name));
1302 dump (0, "p->%sv_%s = NULL;",
1303 st_lower (sbc->prefix), st_lower (sbc->name));
1307 dump (0, "p->%sv_%s = NULL;",
1308 st_lower (sbc->prefix), st_lower (sbc->name));
1312 dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1319 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1320 dump (0, "p->n_%s[i] = NOT_LONG;", st_lower (sbc->name));
1332 /* Return a pointer to a static buffer containing an expression that
1333 will match token T. */
1335 make_match (const char *t)
1345 sprintf (s, "lex_match (T_%s)", t);
1346 else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1347 strcpy (s, "(lex_match_id (\"ON\") || lex_match_id (\"YES\") "
1348 "|| lex_match_id (\"TRUE\"))");
1349 else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1350 strcpy (s, "(lex_match_id (\"OFF\") || lex_match_id (\"NO\") "
1351 "|| lex_match_id (\"FALSE\"))");
1352 else if (isdigit ((unsigned char) t[0]))
1353 sprintf (s, "lex_match_int (%s)", t);
1355 sprintf (s, "lex_match_id (\"%s\")", t);
1360 /* Write out the parsing code for specifier SPEC within subcommand
1363 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1367 if (spec->omit_kw && spec->omit_kw->next)
1368 error ("Omittable setting is not last setting in `%s' specifier.",
1370 if (spec->omit_kw && spec->omit_kw->parent->next)
1371 error ("Default specifier is not in last specifier in `%s' "
1372 "subcommand.", sbc->name);
1374 for (s = spec->s; s; s = s->next)
1376 int first = spec == sbc->spec && s == spec->s;
1378 /* Match the setting's keyword. */
1379 if (spec->omit_kw == s)
1386 dump (1, "%s;", make_match (s->specname));
1389 dump (1, "%sif (%s)", first ? "" : "else ",
1390 make_match (s->specname));
1393 /* Handle values. */
1394 if (s->value == VAL_NONE)
1395 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1396 st_upper (prefix), find_symbol (s->con)->name);
1399 if (spec->omit_kw != s)
1404 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1405 st_upper (prefix), find_symbol (s->con)->name);
1407 if ( sbc->type == SBC_ARRAY )
1408 dump (0, "p->a_%s[%s%s%s] = 1;",
1409 st_lower (sbc->name),
1410 st_upper (prefix), st_upper (sbc->prefix),
1411 st_upper (spec->varname));
1415 if (s->valtype == VT_PAREN)
1419 dump (1, "if (lex_match ('('))");
1424 dump (1, "if (!lex_match ('('))");
1426 dump (0, "msg (SE, _(\"`(' expected after %s "
1427 "specifier of %s subcommand.\"));",
1428 s->specname, sbc->name);
1429 dump (0, "goto lossage;");
1435 if (s->value == VAL_INT)
1437 dump (1, "if (!lex_is_integer ())");
1439 dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1440 "requires an integer argument.\"));",
1441 s->specname, sbc->name);
1442 dump (0, "goto lossage;");
1444 dump (-1, "p->%s%s = lex_integer ();",
1445 sbc->prefix, st_lower (s->valname));
1449 dump (1, "if (!lex_is_number ())");
1451 dump (0, "msg (SE, _(\"Number expected after %s "
1452 "specifier of %s subcommand.\"));",
1453 s->specname, sbc->name);
1454 dump (0, "goto lossage;");
1456 dump (-1, "p->%s%s = tokval;", sbc->prefix,
1457 st_lower (s->valname));
1464 str = xmalloc (MAX_TOK_LEN);
1465 str2 = xmalloc (MAX_TOK_LEN);
1466 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1467 sprintf (str, s->restriction, str2, str2, str2, str2,
1468 str2, str2, str2, str2);
1469 dump (1, "if (!(%s))", str);
1475 dump (0, "msg (SE, _(\"Bad argument for %s "
1476 "specifier of %s subcommand.\"));",
1477 s->specname, sbc->name);
1478 dump (0, "goto lossage;");
1483 dump (0, "lex_get ();");
1485 if (s->valtype == VT_PAREN)
1487 dump (1, "if (!lex_match (')'))");
1489 dump (0, "msg (SE, _(\"`)' expected after argument for "
1490 "%s specifier of %s.\"));",
1491 s->specname, sbc->name);
1492 dump (0, "goto lossage;");
1502 if (s != spec->omit_kw)
1506 if (s == spec->omit_kw)
1515 /* Write out the code to parse subcommand SBC. */
1517 dump_subcommand (const subcommand *sbc)
1519 if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1523 dump (1, "while (token != '/' && token != '.')");
1529 for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1532 dump_specifier_parse (spec, sbc);
1536 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1537 make_match (st_upper (spec->varname)));
1538 if (sbc->type == SBC_PLAIN)
1539 dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1542 dump (0, "p->a_%s[%s%s%s] = 1;",
1543 st_lower (sbc->name),
1544 st_upper (prefix), st_upper (sbc->prefix),
1545 st_upper (spec->varname));
1555 /* This code first finds the last specifier in sbc. Then it
1556 finds the last setting within that last specifier. Either
1557 or both might be NULL. */
1570 if (spec && (!spec->s || !spec->omit_kw))
1574 dump (0, "lex_error (NULL);");
1575 dump (0, "goto lossage;");
1581 dump (0, "lex_match (',');");
1585 else if (sbc->type == SBC_VARLIST)
1587 dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1589 st_lower (sbc->prefix), st_lower (sbc->name),
1590 st_lower (sbc->prefix), st_lower (sbc->name),
1591 sbc->message ? " |" : "",
1592 sbc->message ? sbc->message : "");
1593 dump (0, "goto lossage;");
1596 else if (sbc->type == SBC_VAR)
1598 dump (0, "p->%sv_%s = parse_variable ();",
1599 st_lower (sbc->prefix), st_lower (sbc->name));
1600 dump (1, "if (!p->%sv_%s)",
1601 st_lower (sbc->prefix), st_lower (sbc->name));
1602 dump (0, "goto lossage;");
1605 else if (sbc->type == SBC_STRING)
1607 if (sbc->restriction)
1612 dump (1, "if (!lex_force_string ())");
1613 dump (0, "return 0;");
1615 if (sbc->restriction)
1617 dump (0, "x = ds_length (&tokstr);");
1618 dump (1, "if (!(%s))", sbc->restriction);
1620 dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1621 sbc->name, sbc->message);
1622 dump (0, "goto lossage;");
1626 dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1627 dump (0, "p->s_%s = ds_xstrdup (&tokstr);",
1628 st_lower (sbc->name));
1629 dump (0, "lex_get ();");
1630 if (sbc->restriction)
1633 else if (sbc->type == SBC_DBL)
1635 dump (1, "if (!lex_force_num ())");
1636 dump (0, "goto lossage;");
1637 dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number ();",
1638 st_lower (sbc->name), st_lower (sbc->name) );
1639 dump (0, "lex_get();");
1641 else if (sbc->type == SBC_INT)
1645 dump (1, "if (!lex_force_int ())");
1646 dump (0, "goto lossage;");
1647 dump (-1, "x = lex_integer ();");
1648 dump (0, "lex_get();");
1649 if (sbc->restriction)
1652 dump (1, "if (!(%s))", sbc->restriction);
1654 sprintf(buf,sbc->message,sbc->name);
1655 if ( sbc->translatable )
1656 dump (0, "msg (SE, gettext(\"%s\"));",buf);
1658 dump (0, "msg (SE, \"%s\");",buf);
1659 dump (0, "goto lossage;");
1662 dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1665 else if (sbc->type == SBC_PINT)
1667 dump (0, "lex_match ('(');");
1668 dump (1, "if (!lex_force_int ())");
1669 dump (0, "goto lossage;");
1670 dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
1671 dump (0, "lex_match (')');");
1673 else if (sbc->type == SBC_DBL_LIST)
1675 dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1677 dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1678 dump (0, "goto lossage;");
1681 dump (1, "while (token != '/' && token != '.')");
1683 dump (0, "lex_match(',');");
1684 dump (0, "if (!lex_force_num ())");
1686 dump (0, "goto lossage;");
1689 dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_number ());",
1690 st_lower (sbc->name),st_lower (sbc->name)
1693 dump (0, "lex_get();");
1697 else if (sbc->type == SBC_CUSTOM)
1699 dump (1, "switch (%scustom_%s (p))",
1700 st_lower (prefix), st_lower (sbc->name));
1702 dump (1, "case 0:");
1703 dump (0, "goto lossage;");
1704 dump (-1, "case 1:");
1707 dump (-1, "case 2:");
1709 dump (0, "lex_error (NULL);");
1710 dump (0, "goto lossage;");
1711 dump (-1, "default:");
1713 dump (0, "assert (0);");
1719 /* Write out entire parser. */
1721 dump_parser (int persistent)
1727 dump (0, "static int");
1728 dump (0, "parse_%s (struct cmd_%s *p)", 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))",
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));
1935 dump (1, "for(i = 0; i < MAXLISTS ; ++i)");
1936 dump (0, "subc_list_double_destroy(&p->dl_%s[i]);", st_lower (sbc->name));
1951 /* Returns the name of a directive found on the current input line, if
1952 any, or a null pointer if none found. */
1954 recognize_directive (void)
1956 static char directive[16];
1960 if (strncmp (sp, "/*", 2))
1962 sp = skip_ws (sp + 2);
1967 ep = strchr (sp, ')');
1973 memcpy (directive, sp, ep - sp);
1974 directive[ep - sp] = '\0';
1979 main (int argc, char *argv[])
1981 program_name = argv[0];
1983 fail ("Syntax: q2c input.q output.c");
1986 in = fopen (ifn, "r");
1988 fail ("%s: open: %s.", ifn, strerror (errno));
1991 out = fopen (ofn, "w");
1993 fail ("%s: open: %s.", ofn, strerror (errno));
1996 buf = xmalloc (MAX_LINE_LEN);
1997 tokstr = xmalloc (MAX_TOK_LEN);
2003 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2006 const char *directive = recognize_directive ();
2007 if (directive == NULL)
2009 dump (0, "%s", buf);
2013 dump (0, "#line %d \"%s\"", oln + 1, ofn);
2014 if (!strcmp (directive, "specification"))
2016 /* Skip leading slash-star line. */
2022 /* Skip trailing star-slash line. */
2025 else if (!strcmp (directive, "headers"))
2029 dump (0, "#include <stdlib.h>");
2030 dump (0, "#include <libpspp/alloc.h>");
2031 dump (0, "#include <libpspp/message.h>");
2032 dump (0, "#include <language/lexer/lexer.h>");
2033 dump (0, "#include <data/settings.h>");
2034 dump (0, "#include <libpspp/str.h>");
2035 dump (0, "#include <language/lexer/subcommand-list.h>");
2036 dump (0, "#include <data/variable.h>");
2039 dump (0, "#include \"gettext.h\"");
2040 dump (0, "#define _(msgid) gettext (msgid)");
2043 else if (!strcmp (directive, "declarations"))
2044 dump_declarations ();
2045 else if (!strcmp (directive, "functions"))
2050 else if (!strcmp (directive, "_functions"))
2056 error ("unknown directive `%s'", directive);
2058 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2063 return EXIT_SUCCESS;