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>
36 #define EXIT_SUCCESS 0
40 #define EXIT_FAILURE 1
44 #include <libpspp/debug-print.h>
46 /* Max length of an input line. */
47 #define MAX_LINE_LEN 1024
49 /* Max token length. */
50 #define MAX_TOK_LEN 1024
55 /* Have the input and output files been opened yet? */
58 /* Input, output files. */
61 /* Input, output file names. */
64 /* Input, output file line number. */
67 /* Input line buffer, current position. */
73 T_STRING = 256, /* String literal. */
74 T_ID = 257 /* Identifier. */
77 /* Current token: either one of the above, or a single character. */
80 /* Token string value. */
83 /* Utility functions. */
87 /* Close all open files and delete the output file, on failure. */
96 if (remove (ofn) == -1)
97 fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
100 void hcf (void) NO_RETURN;
102 /* Terminate unsuccessfully. */
110 int fail (const char *, ...) PRINTF_FORMAT (1, 2);
111 int error (const char *, ...) PRINTF_FORMAT (1, 2);
113 /* Output an error message and terminate unsuccessfully. */
115 fail (const char *format, ...)
119 va_start (args, format);
120 fprintf (stderr, "%s: ", program_name);
121 vfprintf (stderr, format, args);
122 fprintf (stderr, "\n");
128 /* Output a context-dependent error message and terminate
131 error (const char *format,...)
135 va_start (args, format);
136 fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
137 vfprintf (stderr, format, args);
138 fprintf (stderr, "\n");
144 #define VME "virtual memory exhausted"
146 /* Allocate a block of SIZE bytes and return a pointer to its
149 xmalloc (size_t size)
158 fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
163 /* Make a dynamically allocated copy of string S and return a pointer
164 to the first character. */
166 xstrdup (const char *s)
172 size = strlen (s) + 1;
176 fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
182 /* Returns a pointer to one of 8 static buffers. The buffers are used
187 static char b[8][256];
196 /* Copies a string to a static buffer, converting it to lowercase in
197 the process, and returns a pointer to the static buffer. */
199 st_lower (const char *s)
203 p = cp = get_buffer ();
205 *cp++ = tolower ((unsigned char) (*s++));
211 /* Copies a string to a static buffer, converting it to uppercase in
212 the process, and returns a pointer to the static buffer. */
214 st_upper (const char *s)
218 p = cp = get_buffer ();
220 *cp++ = toupper ((unsigned char) (*s++));
226 /* Returns the address of the first non-whitespace character in S, or
227 the address of the null terminator if none. */
229 skip_ws (const char *s)
231 while (isspace ((unsigned char) *s))
236 /* Read one line from the input file into buf. Lines having special
237 formats are handled specially. */
242 if (0 == fgets (buf, MAX_LINE_LEN, in))
245 fail ("%s: fgets: %s", ifn, strerror (errno));
249 cp = strchr (buf, '\n');
257 /* Symbol table manager. */
259 /* Symbol table entry. */
260 typedef struct symbol symbol;
263 symbol *next; /* Next symbol in symbol table. */
264 char *name; /* Symbol name. */
265 int unique; /* 1=Name must be unique in this file. */
266 int ln; /* Line number of definition. */
267 int value; /* Symbol value. */
273 /* Add a symbol to the symbol table having name NAME, uniqueness
274 UNIQUE, and value VALUE. If a symbol having the same name is found
275 in the symbol table, its sequence number is returned and the symbol
276 table is not modified. Otherwise, the symbol is added and the next
277 available sequence number is returned. */
279 add_symbol (const char *name, int unique, int value)
284 sym = xmalloc (sizeof *sym);
285 sym->name = xstrdup (name);
286 sym->unique = unique;
299 if (!strcmp (iter->name, name))
303 fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
305 fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
322 /* Finds the symbol having given sequence number X within the symbol
323 table, and returns the associated symbol structure. */
330 while (x > 1 && iter)
340 /* Writes a printable representation of the current token to
348 printf ("STRING\t\"%s\"\n", tokstr);
351 printf ("ID\t%s\n", tokstr);
354 printf ("PUNCT\t%c\n", token);
357 #endif /* DEBUGGING */
359 /* Reads a token from the input file. */
363 /* Skip whitespace and check for end of file. */
371 fail ("%s: Unexpected end of file.", ifn);
379 while (*cp != '"' && *cp)
385 error ("Unterminated string literal.");
393 error ("Unterminated string literal.");
396 else if (*cp == '_' || isalnum ((unsigned char) *cp))
400 while (*cp == '_' || isalnum ((unsigned char) *cp))
401 *dest++ = toupper ((unsigned char) (*cp++));
414 /* Force the current token to be an identifier token. */
419 error ("Identifier expected.");
422 /* Force the current token to be a string token. */
426 if (token != T_STRING)
427 error ("String expected.");
430 /* Checks whether the current token is the identifier S; if so, skips
431 the token and returns 1; otherwise, returns 0. */
433 match_id (const char *s)
435 if (token == T_ID && !strcmp (tokstr, s))
443 /* Checks whether the current token is T. If so, skips the token and
444 returns 1; otherwise, returns 0. */
456 /* Force the current token to be T, and skip it. */
461 error ("`%c' expected.", t);
467 /* Some specifiers have associated values. */
470 VAL_NONE, /* No value. */
471 VAL_INT, /* Integer value. */
472 VAL_DBL /* Floating point value. */
475 /* For those specifiers with values, the syntax of those values. */
478 VT_PLAIN, /* Unadorned value. */
479 VT_PAREN /* Value must be enclosed in parentheses. */
482 /* Forward definition. */
483 typedef struct specifier specifier;
485 /* A single setting. */
486 typedef struct setting setting;
489 specifier *parent; /* Owning specifier. */
490 setting *next; /* Next in the chain. */
491 char *specname; /* Name of the setting. */
492 int con; /* Sequence number. */
495 int valtype; /* One of VT_*. */
496 int value; /* One of VAL_*. */
497 int optvalue; /* 1=value is optional, 0=value is required. */
498 char *valname; /* Variable name for the value. */
499 char *restriction; /* !=NULL: expression specifying valid values. */
502 /* A single specifier. */
505 specifier *next; /* Next in the chain. */
506 char *varname; /* Variable name. */
507 setting *s; /* Associated settings. */
509 setting *def; /* Default setting. */
510 setting *omit_kw; /* Setting for which the keyword can be omitted. */
512 int index; /* Next array index. */
515 /* Subcommand types. */
518 SBC_PLAIN, /* The usual case. */
519 SBC_VARLIST, /* Variable list. */
520 SBC_INT, /* Integer value. */
521 SBC_PINT, /* Integer inside parentheses. */
522 SBC_DBL, /* Floating point value. */
523 SBC_INT_LIST, /* List of integers (?). */
524 SBC_DBL_LIST, /* List of floating points (?). */
525 SBC_CUSTOM, /* Custom. */
526 SBC_ARRAY, /* Array of boolean values. */
527 SBC_STRING, /* String value. */
528 SBC_VAR /* Single variable name. */
534 ARITY_ONCE_EXACTLY, /* must occur exactly once */
535 ARITY_ONCE_ONLY, /* zero or once */
536 ARITY_MANY /* 0, 1, ... , inf */
539 /* A single subcommand. */
540 typedef struct subcommand subcommand;
543 subcommand *next; /* Next in the chain. */
544 char *name; /* Subcommand name. */
545 subcommand_type type; /* One of SBC_*. */
546 subcommand_arity arity; /* How many times should the subcommand occur*/
547 int narray; /* Index of next array element. */
548 const char *prefix; /* Prefix for variable and constant names. */
549 specifier *spec; /* Array of specifiers. */
551 /* SBC_STRING and SBC_INT only. */
552 char *restriction; /* Expression restricting string length. */
553 char *message; /* Error message. */
554 int translatable; /* Error message is translatable */
557 /* Name of the command; i.e., DESCRIPTIVES. */
560 /* Short prefix for the command; i.e., `dsc_'. */
563 /* List of subcommands. */
564 subcommand *subcommands;
566 /* Default subcommand if any, or NULL. */
571 void parse_subcommands (void);
573 /* Parse an entire specification. */
577 /* Get the command name and prefix. */
578 if (token != T_STRING && token != T_ID)
579 error ("Command name expected.");
580 cmdname = xstrdup (tokstr);
584 prefix = xstrdup (tokstr);
589 /* Read all the subcommands. */
592 parse_subcommands ();
595 /* Parses a single setting into S, given subcommand information SBC
596 and specifier information SPEC. */
598 parse_setting (setting *s, specifier *spec)
602 if (match_token ('*'))
605 error ("Cannot have two settings with omittable keywords.");
610 if (match_token ('!'))
613 error ("Cannot have two default settings.");
619 s->specname = xstrdup (tokstr);
620 s->con = add_symbol (s->specname, 0, 0);
625 /* Parse setting value info if necessary. */
626 if (token != '/' && token != ';' && token != '.' && token != ',')
630 s->valtype = VT_PAREN;
634 s->valtype = VT_PLAIN;
636 s->optvalue = match_token ('*');
640 else if (match_id ("D"))
643 error ("`n' or `d' expected.");
648 s->valname = xstrdup (tokstr);
655 s->restriction = xstrdup (tokstr);
659 s->restriction = NULL;
661 if (s->valtype == VT_PAREN)
666 /* Parse a single specifier into SPEC, given subcommand information
669 parse_specifier (specifier *spec, subcommand *sbc)
674 spec->omit_kw = NULL;
675 spec->varname = NULL;
679 spec->varname = xstrdup (st_lower (tokstr));
683 /* Handle array elements. */
686 spec->index = sbc->narray;
687 if (sbc->type == SBC_ARRAY)
699 if ( sbc->type == SBC_ARRAY && token == T_ID )
701 spec->varname = xstrdup (st_lower (tokstr));
702 spec->index = sbc->narray;
708 /* Parse all the settings. */
710 setting **s = &spec->s;
714 *s = xmalloc (sizeof **s);
715 parse_setting (*s, spec);
716 if (token == ',' || token == ';' || token == '.')
725 /* Parse a list of specifiers for subcommand SBC. */
727 parse_specifiers (subcommand *sbc)
729 specifier **spec = &sbc->spec;
731 if (token == ';' || token == '.')
739 *spec = xmalloc (sizeof **spec);
740 parse_specifier (*spec, sbc);
741 if (token == ';' || token == '.')
744 spec = &(*spec)->next;
746 (*spec)->next = NULL;
749 /* Parse a subcommand into SBC. */
751 parse_subcommand (subcommand *sbc)
753 sbc->arity = ARITY_MANY;
755 if (match_token ('*'))
758 error ("Multiple default subcommands.");
762 if ( match_token('+'))
763 sbc->arity = ARITY_ONCE_ONLY ;
764 else if (match_token('^'))
765 sbc->arity = ARITY_ONCE_EXACTLY ;
769 sbc->name = xstrdup (tokstr);
773 sbc->type = SBC_PLAIN;
775 sbc->translatable = 0;
777 if (match_token ('['))
780 sbc->prefix = xstrdup (st_lower (tokstr));
786 sbc->type = SBC_ARRAY;
787 parse_specifiers (sbc);
792 if (match_token ('('))
795 sbc->prefix = xstrdup (st_lower (tokstr));
805 if (match_id ("VAR"))
807 if (match_id ("VARLIST"))
809 if (match_token ('('))
812 sbc->message = xstrdup (tokstr);
817 else sbc->message = NULL;
819 sbc->type = SBC_VARLIST;
821 else if (match_id ("INTEGER"))
823 sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
824 if ( token == T_STRING)
826 sbc->restriction = xstrdup (tokstr);
828 if ( match_id("N_") )
834 sbc->translatable = 1;
840 sbc->message = xstrdup (tokstr);
843 sbc->restriction = NULL;
845 else if (match_id ("PINT"))
846 sbc->type = SBC_PINT;
847 else if (match_id ("DOUBLE"))
849 if ( match_id ("LIST") )
850 sbc->type = SBC_DBL_LIST;
854 else if (match_id ("STRING"))
856 sbc->type = SBC_STRING;
857 if (token == T_STRING)
859 sbc->restriction = xstrdup (tokstr);
862 sbc->message = xstrdup (tokstr);
866 sbc->restriction = NULL;
868 else if (match_id ("CUSTOM"))
869 sbc->type = SBC_CUSTOM;
871 parse_specifiers (sbc);
875 /* Parse all the subcommands. */
877 parse_subcommands (void)
879 subcommand **sbc = &subcommands;
883 *sbc = xmalloc (sizeof **sbc);
886 parse_subcommand (*sbc);
898 #define BASE_INDENT 2 /* Starting indent. */
899 #define INC_INDENT 2 /* Indent increment. */
901 /* Increment the indent. */
902 #define indent() indent += INC_INDENT
903 #define outdent() indent -= INC_INDENT
905 /* Size of the indent from the left margin. */
908 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
910 /* Write line FORMAT to the output file, formatted as with printf,
911 indented `indent' characters from the left margin. If INDENTION is
912 greater than 0, indents BASE_INDENT * INDENTION characters after
913 writing the line; if INDENTION is less than 0, dedents BASE_INDENT
914 * INDENTION characters _before_ writing the line. */
916 dump (int indention, const char *format, ...)
922 indent += BASE_INDENT * indention;
925 va_start (args, format);
926 for (i = 0; i < indent; i++)
928 vfprintf (out, format, args);
933 indent += BASE_INDENT * indention;
936 /* Write the structure members for specifier SPEC to the output file.
937 SBC is the including subcommand. */
939 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
942 dump (0, "long %s%s;", sbc->prefix, spec->varname);
947 for (s = spec->s; s; s = s->next)
949 if (s->value != VAL_NONE)
951 const char *typename;
953 assert (s->value == VAL_INT || s->value == VAL_DBL);
954 typename = s->value == VAL_INT ? "long" : "double";
956 dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
962 /* Returns 1 if string T is a PSPP keyword, 0 otherwise. */
964 is_keyword (const char *t)
966 static const char *kw[] =
968 "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
969 "NE", "ALL", "BY", "TO", "WITH", 0,
973 for (cp = kw; *cp; cp++)
974 if (!strcmp (t, *cp))
979 /* Transforms a string NAME into a valid C identifier: makes
980 everything lowercase and maps nonalphabetic characters to
981 underscores. Returns a pointer to a static buffer. */
983 make_identifier (const char *name)
985 char *p = get_buffer ();
988 for (cp = p; *name; name++)
989 if (isalpha ((unsigned char) *name))
990 *cp++ = tolower ((unsigned char) (*name));
998 /* Writes the struct and enum declarations for the parser. */
1000 dump_declarations (void)
1004 /* Write out enums for all the identifiers in the symbol table. */
1010 /* Note the squirmings necessary to make sure that the last enum
1011 is not followed by a comma, as mandated by ANSI C89. */
1012 for (sym = symtab, f = k = 0; sym; sym = sym->next)
1013 if (!sym->unique && !is_keyword (sym->name))
1017 dump (0, "/* Settings for subcommand specifiers. */");
1024 buf = xmalloc (1024);
1029 sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
1033 sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
1038 buf[strlen (buf) - 1] = 0;
1049 /* Write out some type definitions */
1051 dump (0, "#define MAXLISTS 10");
1055 /* For every array subcommand, write out the associated enumerated
1060 for (sbc = subcommands; sbc; sbc = sbc->next)
1061 if (sbc->type == SBC_ARRAY && sbc->narray)
1063 dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1071 for (spec = sbc->spec; spec; spec = spec->next)
1072 dump (0, "%s%s%s = %d,",
1073 st_upper (prefix), st_upper (sbc->prefix),
1074 st_upper (spec->varname), spec->index);
1076 dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1084 /* Write out structure declaration. */
1088 dump (0, "/* %s structure. */", cmdname);
1089 dump (1, "struct cmd_%s", make_identifier (cmdname));
1091 for (sbc = subcommands; sbc; sbc = sbc->next)
1095 if (sbc != subcommands)
1098 dump (0, "/* %s subcommand. */", sbc->name);
1099 dump (0, "int sbc_%s;", st_lower (sbc->name));
1108 for (spec = sbc->spec; spec; spec = spec->next)
1112 if (sbc->type == SBC_PLAIN)
1113 dump (0, "long int %s%s;", st_lower (sbc->prefix),
1117 dump (0, "int a_%s[%s%scount];",
1118 st_lower (sbc->name),
1120 st_upper (sbc->prefix)
1127 dump_specifier_vars (spec, sbc);
1133 dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
1134 st_lower (sbc->name));
1135 dump (0, "struct variable **%sv_%s;", st_lower (sbc->prefix),
1136 st_lower (sbc->name));
1140 dump (0, "struct variable *%sv_%s;", st_lower (sbc->prefix),
1141 st_lower (sbc->name));
1145 dump (0, "char *s_%s;", st_lower (sbc->name));
1150 dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
1154 dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
1158 dump (0, "subc_list_double dl_%s[MAXLISTS];",
1159 st_lower(sbc->name));
1163 dump (0, "subc_list_int il_%s[MAXLISTS];",
1164 st_lower(sbc->name));
1177 /* Write out prototypes for custom_*() functions as necessary. */
1182 for (sbc = subcommands; sbc; sbc = sbc->next)
1183 if (sbc->type == SBC_CUSTOM)
1188 dump (0, "/* Prototype for custom subcommands of %s. */",
1191 dump (0, "static int %scustom_%s (struct cmd_%s *);",
1192 st_lower (prefix), st_lower (sbc->name),
1193 make_identifier (cmdname));
1200 /* Prototypes for parsing and freeing functions. */
1202 dump (0, "/* Command parsing functions. */");
1203 dump (0, "static int parse_%s (struct cmd_%s *);",
1204 make_identifier (cmdname), make_identifier (cmdname));
1205 dump (0, "static void free_%s (struct cmd_%s *);",
1206 make_identifier (cmdname), make_identifier (cmdname));
1211 /* Writes out code to initialize all the variables that need
1212 initialization for particular specifier SPEC inside subcommand SBC. */
1214 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1222 st_upper (prefix), find_symbol (spec->def->con)->name);
1225 dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1231 for (s = spec->s; s; s = s->next)
1233 if (s->value != VAL_NONE)
1237 assert (s->value == VAL_INT || s->value == VAL_DBL);
1238 init = s->value == VAL_INT ? "NOT_LONG" : "SYSMIS";
1240 dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1246 /* Write code to initialize all variables. */
1248 dump_vars_init (int persistent)
1250 /* Loop through all the subcommands. */
1254 for (sbc = subcommands; sbc; sbc = sbc->next)
1258 dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1269 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1270 dump (0, "subc_list_double_create(&p->dl_%s[i]) ;",
1271 st_lower (sbc->name)
1279 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1280 dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
1293 for (spec = sbc->spec; spec; spec = spec->next)
1294 if (spec->s == NULL)
1296 if (sbc->type == SBC_PLAIN)
1297 dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1300 dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1301 st_lower (sbc->name), st_lower (sbc->name));
1306 dump_specifier_init (spec, sbc);
1311 dump (0, "p->%sn_%s = 0;",
1312 st_lower (sbc->prefix), st_lower (sbc->name));
1313 dump (0, "p->%sv_%s = NULL;",
1314 st_lower (sbc->prefix), st_lower (sbc->name));
1318 dump (0, "p->%sv_%s = NULL;",
1319 st_lower (sbc->prefix), st_lower (sbc->name));
1323 dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1330 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1331 dump (0, "p->n_%s[i] = NOT_LONG;", st_lower (sbc->name));
1343 /* Return a pointer to a static buffer containing an expression that
1344 will match token T. */
1346 make_match (const char *t)
1356 sprintf (s, "lex_match (T_%s)", t);
1357 else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1358 strcpy (s, "(lex_match_id (\"ON\") || lex_match_id (\"YES\") "
1359 "|| lex_match_id (\"TRUE\"))");
1360 else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1361 strcpy (s, "(lex_match_id (\"OFF\") || lex_match_id (\"NO\") "
1362 "|| lex_match_id (\"FALSE\"))");
1363 else if (isdigit ((unsigned char) t[0]))
1364 sprintf (s, "lex_match_int (%s)", t);
1366 sprintf (s, "lex_match_id (\"%s\")", t);
1371 /* Write out the parsing code for specifier SPEC within subcommand
1374 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1378 if (spec->omit_kw && spec->omit_kw->next)
1379 error ("Omittable setting is not last setting in `%s' specifier.",
1381 if (spec->omit_kw && spec->omit_kw->parent->next)
1382 error ("Default specifier is not in last specifier in `%s' "
1383 "subcommand.", sbc->name);
1385 for (s = spec->s; s; s = s->next)
1387 int first = spec == sbc->spec && s == spec->s;
1389 /* Match the setting's keyword. */
1390 if (spec->omit_kw == s)
1397 dump (1, "%s;", make_match (s->specname));
1400 dump (1, "%sif (%s)", first ? "" : "else ",
1401 make_match (s->specname));
1404 /* Handle values. */
1405 if (s->value == VAL_NONE)
1406 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1407 st_upper (prefix), find_symbol (s->con)->name);
1410 if (spec->omit_kw != s)
1415 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1416 st_upper (prefix), find_symbol (s->con)->name);
1418 if ( sbc->type == SBC_ARRAY )
1419 dump (0, "p->a_%s[%s%s%s] = 1;",
1420 st_lower (sbc->name),
1421 st_upper (prefix), st_upper (sbc->prefix),
1422 st_upper (spec->varname));
1426 if (s->valtype == VT_PAREN)
1430 dump (1, "if (lex_match ('('))");
1435 dump (1, "if (!lex_match ('('))");
1437 dump (0, "msg (SE, _(\"`(' expected after %s "
1438 "specifier of %s subcommand.\"));",
1439 s->specname, sbc->name);
1440 dump (0, "goto lossage;");
1446 if (s->value == VAL_INT)
1448 dump (1, "if (!lex_is_integer ())");
1450 dump (0, "msg (SE, _(\"%s specifier of %s subcommand "
1451 "requires an integer argument.\"));",
1452 s->specname, sbc->name);
1453 dump (0, "goto lossage;");
1455 dump (-1, "p->%s%s = lex_integer ();",
1456 sbc->prefix, st_lower (s->valname));
1460 dump (1, "if (!lex_is_number ())");
1462 dump (0, "msg (SE, _(\"Number expected after %s "
1463 "specifier of %s subcommand.\"));",
1464 s->specname, sbc->name);
1465 dump (0, "goto lossage;");
1467 dump (-1, "p->%s%s = tokval;", sbc->prefix,
1468 st_lower (s->valname));
1475 str = xmalloc (MAX_TOK_LEN);
1476 str2 = xmalloc (MAX_TOK_LEN);
1477 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1478 sprintf (str, s->restriction, str2, str2, str2, str2,
1479 str2, str2, str2, str2);
1480 dump (1, "if (!(%s))", str);
1486 dump (0, "msg (SE, _(\"Bad argument for %s "
1487 "specifier of %s subcommand.\"));",
1488 s->specname, sbc->name);
1489 dump (0, "goto lossage;");
1494 dump (0, "lex_get ();");
1496 if (s->valtype == VT_PAREN)
1498 dump (1, "if (!lex_match (')'))");
1500 dump (0, "msg (SE, _(\"`)' expected after argument for "
1501 "%s specifier of %s.\"));",
1502 s->specname, sbc->name);
1503 dump (0, "goto lossage;");
1513 if (s != spec->omit_kw)
1517 if (s == spec->omit_kw)
1526 /* Write out the code to parse subcommand SBC. */
1528 dump_subcommand (const subcommand *sbc)
1530 if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1534 dump (1, "while (token != '/' && token != '.')");
1540 for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1543 dump_specifier_parse (spec, sbc);
1547 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1548 make_match (st_upper (spec->varname)));
1549 if (sbc->type == SBC_PLAIN)
1550 dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1553 dump (0, "p->a_%s[%s%s%s] = 1;",
1554 st_lower (sbc->name),
1555 st_upper (prefix), st_upper (sbc->prefix),
1556 st_upper (spec->varname));
1566 /* This code first finds the last specifier in sbc. Then it
1567 finds the last setting within that last specifier. Either
1568 or both might be NULL. */
1581 if (spec && (!spec->s || !spec->omit_kw))
1585 dump (0, "lex_error (NULL);");
1586 dump (0, "goto lossage;");
1592 dump (0, "lex_match (',');");
1596 else if (sbc->type == SBC_VARLIST)
1598 dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1600 st_lower (sbc->prefix), st_lower (sbc->name),
1601 st_lower (sbc->prefix), st_lower (sbc->name),
1602 sbc->message ? " |" : "",
1603 sbc->message ? sbc->message : "");
1604 dump (0, "goto lossage;");
1607 else if (sbc->type == SBC_VAR)
1609 dump (0, "p->%sv_%s = parse_variable ();",
1610 st_lower (sbc->prefix), st_lower (sbc->name));
1611 dump (1, "if (!p->%sv_%s)",
1612 st_lower (sbc->prefix), st_lower (sbc->name));
1613 dump (0, "goto lossage;");
1616 else if (sbc->type == SBC_STRING)
1618 if (sbc->restriction)
1623 dump (1, "if (!lex_force_string ())");
1624 dump (0, "return 0;");
1626 if (sbc->restriction)
1628 dump (0, "x = ds_length (&tokstr);");
1629 dump (1, "if (!(%s))", sbc->restriction);
1631 dump (0, "msg (SE, _(\"String for %s must be %s.\"));",
1632 sbc->name, sbc->message);
1633 dump (0, "goto lossage;");
1637 dump (0, "free(p->s_%s);", st_lower(sbc->name) );
1638 dump (0, "p->s_%s = xstrdup (ds_c_str (&tokstr));",
1639 st_lower (sbc->name));
1640 dump (0, "lex_get ();");
1641 if (sbc->restriction)
1644 else if (sbc->type == SBC_DBL)
1646 dump (1, "if (!lex_force_num ())");
1647 dump (0, "goto lossage;");
1648 dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number ();",
1649 st_lower (sbc->name), st_lower (sbc->name) );
1650 dump (0, "lex_get();");
1652 else if (sbc->type == SBC_INT)
1656 dump (1, "if (!lex_force_int ())");
1657 dump (0, "goto lossage;");
1658 dump (-1, "x = lex_integer ();");
1659 dump (0, "lex_get();");
1660 if (sbc->restriction)
1663 dump (1, "if (!(%s))", sbc->restriction);
1665 sprintf(buf,sbc->message,sbc->name);
1666 if ( sbc->translatable )
1667 dump (0, "msg (SE, gettext(\"%s\"));",buf);
1669 dump (0, "msg (SE, \"%s\");",buf);
1670 dump (0, "goto lossage;");
1673 dump (0, "p->n_%s[p->sbc_%s - 1] = x;", st_lower (sbc->name), st_lower(sbc->name) );
1676 else if (sbc->type == SBC_PINT)
1678 dump (0, "lex_match ('(');");
1679 dump (1, "if (!lex_force_int ())");
1680 dump (0, "goto lossage;");
1681 dump (-1, "p->n_%s = lex_integer ();", st_lower (sbc->name));
1682 dump (0, "lex_match (')');");
1684 else if (sbc->type == SBC_DBL_LIST)
1686 dump (0, "if ( p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1688 dump (0, "msg (SE, \"No more than %%d %s subcommands allowed\",MAXLISTS);",st_lower(sbc->name));
1689 dump (0, "goto lossage;");
1692 dump (1, "while (token != '/' && token != '.')");
1694 dump (0, "lex_match(',');");
1695 dump (0, "if (!lex_force_num ())");
1697 dump (0, "goto lossage;");
1700 dump (0, "subc_list_double_push(&p->dl_%s[p->sbc_%s-1],lex_number ());",
1701 st_lower (sbc->name),st_lower (sbc->name)
1704 dump (0, "lex_get();");
1708 else if (sbc->type == SBC_CUSTOM)
1710 dump (1, "switch (%scustom_%s (p))",
1711 st_lower (prefix), st_lower (sbc->name));
1713 dump (1, "case 0:");
1714 dump (0, "goto lossage;");
1715 dump (-1, "case 1:");
1718 dump (-1, "case 2:");
1720 dump (0, "lex_error (NULL);");
1721 dump (0, "goto lossage;");
1722 dump (-1, "default:");
1724 dump (0, "assert (0);");
1730 /* Write out entire parser. */
1732 dump_parser (int persistent)
1738 dump (0, "static int");
1739 dump (0, "parse_%s (struct cmd_%s *p)", make_identifier (cmdname),
1740 make_identifier (cmdname));
1743 dump_vars_init (persistent);
1745 dump (1, "for (;;)");
1749 if (def && (def->type == SBC_VARLIST))
1751 if (def->type == SBC_VARLIST)
1752 dump (1, "if (token == T_ID "
1753 "&& dict_lookup_var (default_dict, tokid) != NULL "
1754 "&& lex_look_ahead () != '=')");
1757 dump (0, "if ((token == T_ID "
1758 "&& dict_lookup_var (default_dict, tokid) "
1759 "&& lex_look_ahead () != '=')");
1760 dump (1, " || token == T_ALL)");
1763 dump (0, "p->sbc_%s++;", st_lower (def->name));
1764 dump (1, "if (!parse_variables (default_dict, &p->%sv_%s, &p->%sn_%s, "
1766 st_lower (def->prefix), st_lower (def->name),
1767 st_lower (def->prefix), st_lower (def->name));
1768 dump (0, "goto lossage;");
1773 else if (def && def->type == SBC_CUSTOM)
1775 dump (1, "switch (%scustom_%s (p))",
1776 st_lower (prefix), st_lower (def->name));
1778 dump (1, "case 0:");
1779 dump (0, "goto lossage;");
1780 dump (-1, "case 1:");
1782 dump (0, "p->sbc_%s++;", st_lower (def->name));
1783 dump (0, "continue;");
1784 dump (-1, "case 2:");
1787 dump (-1, "default:");
1789 dump (0, "assert (0);");
1797 for (sbc = subcommands; sbc; sbc = sbc->next)
1799 dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1803 dump (0, "lex_match ('=');");
1804 dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1805 if (sbc->arity != ARITY_MANY)
1807 dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1809 dump (0, "msg (SE, _(\"%s subcommand may be given only once.\"));",
1811 dump (0, "goto lossage;");
1815 dump_subcommand (sbc);
1822 /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1823 dump(1,"else if ( get_syntax() != COMPATIBLE && lex_match_id(\"ALGORITHM\"))");
1826 dump (0, "lex_match ('=');");
1828 dump(1,"if (lex_match_id(\"COMPATIBLE\"))");
1829 dump(0,"set_cmd_algorithm(COMPATIBLE);");
1831 dump(1,"else if (lex_match_id(\"ENHANCED\"))");
1832 dump(0,"set_cmd_algorithm(ENHANCED);");
1839 dump (1, "if (!lex_match ('/'))");
1844 dump (1, "if (token != '.')");
1846 dump (0, "lex_error (_(\"expecting end of command\"));");
1847 dump (0, "goto lossage;");
1854 /* Check that mandatory subcommands have been specified */
1857 for (sbc = subcommands; sbc; sbc = sbc->next)
1860 if ( sbc->arity == ARITY_ONCE_EXACTLY )
1862 dump (0, "if ( 0 == p->sbc_%s)", st_lower (sbc->name));
1864 dump (0, "msg (SE, _(\"%s subcommand must be given.\"));",
1866 dump (0, "goto lossage;");
1873 dump (-1, "return 1;");
1875 dump (-1, "lossage:");
1877 dump (0, "free_%s (p);", make_identifier (cmdname));
1878 dump (0, "return 0;");
1884 /* Write the output file header. */
1893 curtime = time (NULL);
1894 loctime = localtime (&curtime);
1895 timep = asctime (loctime);
1896 timep[strlen (timep) - 1] = 0;
1897 dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1899 dump (0, " Generated by q2c from %s on %s.", ifn, timep);
1900 dump (0, " Do not modify!");
1904 /* Write out commands to free variable state. */
1906 dump_free (int persistent)
1916 for (sbc = subcommands; sbc; sbc = sbc->next)
1918 if (sbc->type == SBC_STRING)
1920 if (sbc->type == SBC_DBL_LIST)
1926 dump (0, "static void");
1927 dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1928 make_identifier (cmdname), used ? "" : " UNUSED");
1934 for (sbc = subcommands; sbc; sbc = sbc->next)
1939 dump (0, "free (p->v_%s);", st_lower (sbc->name));
1942 dump (0, "free (p->s_%s);", st_lower (sbc->name));
1946 dump (1, "for(i = 0; i < MAXLISTS ; ++i)");
1947 dump (0, "subc_list_double_destroy(&p->dl_%s[i]);", st_lower (sbc->name));
1962 /* Returns the name of a directive found on the current input line, if
1963 any, or a null pointer if none found. */
1965 recognize_directive (void)
1967 static char directive[16];
1971 if (strncmp (sp, "/*", 2))
1973 sp = skip_ws (sp + 2);
1978 ep = strchr (sp, ')');
1984 memcpy (directive, sp, ep - sp);
1985 directive[ep - sp] = '\0';
1990 main (int argc, char *argv[])
1992 program_name = argv[0];
1994 fail ("Syntax: q2c input.q output.c");
1997 in = fopen (ifn, "r");
1999 fail ("%s: open: %s.", ifn, strerror (errno));
2002 out = fopen (ofn, "w");
2004 fail ("%s: open: %s.", ofn, strerror (errno));
2007 buf = xmalloc (MAX_LINE_LEN);
2008 tokstr = xmalloc (MAX_TOK_LEN);
2014 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2017 const char *directive = recognize_directive ();
2018 if (directive == NULL)
2020 dump (0, "%s", buf);
2024 dump (0, "#line %d \"%s\"", oln + 1, ofn);
2025 if (!strcmp (directive, "specification"))
2027 /* Skip leading slash-star line. */
2033 /* Skip trailing star-slash line. */
2036 else if (!strcmp (directive, "headers"))
2040 dump (0, "#include <stdlib.h>");
2041 dump (0, "#include <libpspp/alloc.h>");
2042 dump (0, "#include <libpspp/message.h>");
2043 dump (0, "#include <language/lexer/lexer.h>");
2044 dump (0, "#include <data/settings.h>");
2045 dump (0, "#include <libpspp/str.h>");
2046 dump (0, "#include <language/lexer/subcommand-list.h>");
2047 dump (0, "#include <data/variable.h>");
2050 dump (0, "#include \"gettext.h\"");
2051 dump (0, "#define _(msgid) gettext (msgid)");
2054 else if (!strcmp (directive, "declarations"))
2055 dump_declarations ();
2056 else if (!strcmp (directive, "functions"))
2061 else if (!strcmp (directive, "_functions"))
2067 error ("unknown directive `%s'", directive);
2069 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2074 return EXIT_SUCCESS;