1 /* PSPP - a program for statistical analysis.
2 Copyright (C) 1997-9, 2000, 2008, 2010, 2011 Free Software Foundation, Inc.
4 This program is free software: you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation, either version 3 of the License, or
7 (at your option) any later version.
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
14 You should have received a copy of the GNU General Public License
15 along with this program. If not, see <http://www.gnu.org/licenses/>. */
27 /* GNU C allows the programmer to declare that certain functions take
28 printf-like arguments, never return, etc. Conditionalize these
29 declarations on whether gcc is in use. */
31 #define ATTRIBUTE(X) __attribute__ (X)
36 /* Marks a function argument as possibly not used. */
37 #define UNUSED ATTRIBUTE ((unused))
39 /* Marks a function that will never return. */
40 #define NO_RETURN ATTRIBUTE ((noreturn))
42 /* Mark a function as taking a printf- or scanf-like format
43 string as its FMT'th argument and that the FIRST'th argument
44 is the first one to be checked against the format string. */
45 #define PRINTF_FORMAT(FMT, FIRST) ATTRIBUTE ((format (__printf__, FMT, FIRST)))
47 /* Max length of an input line. */
48 #define MAX_LINE_LEN 1024
50 /* Max token length. */
51 #define MAX_TOK_LEN 1024
54 static char *program_name;
56 /* Have the input and output files been opened yet? */
59 /* Input, output files. */
60 static FILE *in, *out;
62 /* Input, output file names. */
63 static char *ifn, *ofn;
65 /* Input, output file line number. */
66 static int ln, oln = 1;
68 /* Input line buffer, current position. */
69 static char *buf, *cp;
74 T_STRING = 256, /* String literal. */
75 T_ID = 257 /* Identifier. */
78 /* Current token: either one of the above, or a single character. */
81 /* Token string value. */
84 /* Utility functions. */
86 /* Close all open files and delete the output file, on failure. */
95 if (remove (ofn) == -1)
96 fprintf (stderr, "%s: %s: remove: %s\n", program_name, ofn, strerror (errno));
99 void hcf (void) NO_RETURN;
101 /* Terminate unsuccessfully. */
109 int fail (const char *, ...) PRINTF_FORMAT (1, 2) NO_RETURN;
110 int error (const char *, ...) PRINTF_FORMAT (1, 2) NO_RETURN;
112 /* Output an error message and terminate unsuccessfully. */
114 fail (const char *format, ...)
118 va_start (args, format);
119 fprintf (stderr, "%s: ", program_name);
120 vfprintf (stderr, format, args);
121 fprintf (stderr, "\n");
127 /* Output a context-dependent error message and terminate
130 error (const char *format,...)
134 va_start (args, format);
135 fprintf (stderr, "%s:%d: (column %d) ", ifn, ln, (int) (cp - buf));
136 vfprintf (stderr, format, args);
137 fprintf (stderr, "\n");
143 #define VME "virtual memory exhausted"
145 /* Allocate a block of SIZE bytes and return a pointer to its
148 xmalloc (size_t size)
157 fail ("xmalloc(%lu): %s", (unsigned long) size, VME);
162 /* Make a dynamically allocated copy of string S and return a pointer
163 to the first character. */
165 xstrdup (const char *s)
171 size = strlen (s) + 1;
175 fail ("xstrdup(%lu): %s", (unsigned long) strlen (s), VME);
181 /* Returns a pointer to one of 8 static buffers. The buffers are used
186 static char b[8][256];
195 /* Copies a string to a static buffer, converting it to lowercase in
196 the process, and returns a pointer to the static buffer. */
198 st_lower (const char *s)
202 p = cp = get_buffer ();
204 *cp++ = tolower ((unsigned char) (*s++));
210 /* Copies a string to a static buffer, converting it to uppercase in
211 the process, and returns a pointer to the static buffer. */
213 st_upper (const char *s)
217 p = cp = get_buffer ();
219 *cp++ = toupper ((unsigned char) (*s++));
225 /* Returns the address of the first non-whitespace character in S, or
226 the address of the null terminator if none. */
230 while (isspace ((unsigned char) *s))
235 /* Read one line from the input file into buf. Lines having special
236 formats are handled specially. */
241 if (0 == fgets (buf, MAX_LINE_LEN, in))
244 fail ("%s: fgets: %s", ifn, strerror (errno));
248 cp = strchr (buf, '\n');
256 /* Symbol table manager. */
258 /* Symbol table entry. */
259 typedef struct symbol symbol;
262 symbol *next; /* Next symbol in symbol table. */
263 char *name; /* Symbol name. */
264 int unique; /* 1=Name must be unique in this file. */
265 int ln; /* Line number of definition. */
266 int value; /* Symbol value. */
272 /* Add a symbol to the symbol table having name NAME, uniqueness
273 UNIQUE, and value VALUE. If a symbol having the same name is found
274 in the symbol table, its sequence number is returned and the symbol
275 table is not modified. Otherwise, the symbol is added and the next
276 available sequence number is returned. */
278 add_symbol (const char *name, int unique, int value)
283 sym = xmalloc (sizeof *sym);
284 sym->name = xstrdup (name);
285 sym->unique = unique;
298 if (!strcmp (iter->name, name))
302 fprintf (stderr, "%s:%d: `%s' is already defined above\n", ifn,
304 fprintf (stderr, "%s:%d: location of previous definition\n", ifn,
321 /* Finds the symbol having given sequence number X within the symbol
322 table, and returns the associated symbol structure. */
329 while (x > 1 && iter)
339 /* Writes a printable representation of the current token to
347 printf ("STRING\t\"%s\"\n", tokstr);
350 printf ("ID\t%s\n", tokstr);
353 printf ("PUNCT\t%c\n", token);
356 #endif /* DUMP_TOKENS */
359 const char hyphen_proxy = '_';
367 while (*src == '_' || *src == '-' || isalnum ((unsigned char) *src))
369 *dest++ = *src == '-' ? hyphen_proxy :toupper ((unsigned char) (*src));
378 unmunge (const char *s)
380 char *dest = xmalloc (strlen (s) + 1);
385 if (*s == hyphen_proxy)
397 /* Reads a token from the input file. */
401 /* Skip whitespace and check for end of file. */
409 fail ("%s: Unexpected end of file.", ifn);
417 while (*cp != '"' && *cp)
423 error ("Unterminated string literal.");
431 error ("Unterminated string literal.");
434 else if (*cp == '_' || isalnum ((unsigned char) *cp))
451 /* Force the current token to be an identifier token. */
456 error ("Identifier expected.");
459 /* Force the current token to be a string token. */
463 if (token != T_STRING)
464 error ("String expected.");
467 /* Checks whether the current token is the identifier S; if so, skips
468 the token and returns true; otherwise, returns false. */
470 match_id (const char *s)
472 if (token == T_ID && !strcmp (tokstr, s))
480 /* Checks whether the current token is T. If so, skips the token and
481 returns true; otherwise, returns false. */
493 /* Force the current token to be T, and skip it. */
498 error ("`%c' expected.", t);
504 /* Some specifiers have associated values. */
507 VAL_NONE, /* No value. */
508 VAL_INT, /* Integer value. */
509 VAL_DBL, /* Floating point value. */
510 VAL_STRING /* String value. */
513 /* For those specifiers with values, the syntax of those values. */
516 VT_PLAIN, /* Unadorned value. */
517 VT_PAREN /* Value must be enclosed in parentheses. */
520 /* Forward definition. */
521 typedef struct specifier specifier;
523 /* A single setting. */
524 typedef struct setting setting;
527 specifier *parent; /* Owning specifier. */
528 setting *next; /* Next in the chain. */
529 char *specname; /* Name of the setting. */
530 int con; /* Sequence number. */
533 int valtype; /* One of VT_*. */
534 int value; /* One of VAL_*. */
535 int optvalue; /* 1=value is optional, 0=value is required. */
536 char *valname; /* Variable name for the value. */
537 char *restriction; /* !=NULL: expression specifying valid values. */
540 /* A single specifier. */
543 specifier *next; /* Next in the chain. */
544 char *varname; /* Variable name. */
545 setting *s; /* Associated settings. */
547 setting *def; /* Default setting. */
548 setting *omit_kw; /* Setting for which the keyword can be omitted. */
550 int index; /* Next array index. */
553 /* Subcommand types. */
556 SBC_PLAIN, /* The usual case. */
557 SBC_VARLIST, /* Variable list. */
558 SBC_INT, /* Integer value. */
559 SBC_PINT, /* Integer inside parentheses. */
560 SBC_DBL, /* Floating point value. */
561 SBC_INT_LIST, /* List of integers (?). */
562 SBC_DBL_LIST, /* List of floating points (?). */
563 SBC_CUSTOM, /* Custom. */
564 SBC_ARRAY, /* Array of boolean values. */
565 SBC_STRING, /* String value. */
566 SBC_VAR /* Single variable name. */
572 ARITY_ONCE_EXACTLY, /* must occur exactly once */
573 ARITY_ONCE_ONLY, /* zero or once */
574 ARITY_MANY /* 0, 1, ... , inf */
577 /* A single subcommand. */
578 typedef struct subcommand subcommand;
581 subcommand *next; /* Next in the chain. */
582 char *name; /* Subcommand name. */
583 subcommand_type type; /* One of SBC_*. */
584 subcommand_arity arity; /* How many times should the subcommand occur*/
585 int narray; /* Index of next array element. */
586 const char *prefix; /* Prefix for variable and constant names. */
587 specifier *spec; /* Array of specifiers. */
588 char *pv_options; /* PV_* options for SBC_VARLIST. */
591 /* Name of the command; i.e., DESCRIPTIVES. */
594 /* Short prefix for the command; i.e., `dsc_'. */
597 /* List of subcommands. */
598 subcommand *subcommands;
600 /* Default subcommand if any, or NULL. */
605 void parse_subcommands (void);
607 /* Parse an entire specification. */
611 /* Get the command name and prefix. */
612 if (token != T_STRING && token != T_ID)
613 error ("Command name expected.");
614 cmdname = xstrdup (tokstr);
618 prefix = xstrdup (tokstr);
623 /* Read all the subcommands. */
626 parse_subcommands ();
629 /* Parses a single setting into S, given subcommand information SBC
630 and specifier information SPEC. */
632 parse_setting (setting *s, specifier *spec)
636 if (match_token ('*'))
639 error ("Cannot have two settings with omittable keywords.");
644 if (match_token ('!'))
647 error ("Cannot have two default settings.");
653 s->specname = xstrdup (tokstr);
654 s->con = add_symbol (s->specname, 0, 0);
659 /* Parse setting value info if necessary. */
660 if (token != '/' && token != ';' && token != '.' && token != ',')
664 s->valtype = VT_PAREN;
668 s->valtype = VT_PLAIN;
670 s->optvalue = match_token ('*');
674 else if (match_id ("D"))
676 else if (match_id ("S"))
677 s->value = VAL_STRING;
679 error ("`n', `d', or `s' expected.");
684 s->valname = xstrdup (tokstr);
691 s->restriction = xstrdup (tokstr);
695 s->restriction = NULL;
697 if (s->valtype == VT_PAREN)
702 /* Parse a single specifier into SPEC, given subcommand information
705 parse_specifier (specifier *spec, subcommand *sbc)
710 spec->omit_kw = NULL;
711 spec->varname = NULL;
715 spec->varname = xstrdup (st_lower (tokstr));
719 /* Handle array elements. */
722 spec->index = sbc->narray;
723 if (sbc->type == SBC_ARRAY)
735 if (sbc->type == SBC_ARRAY && token == T_ID)
737 spec->varname = xstrdup (st_lower (tokstr));
738 spec->index = sbc->narray;
744 /* Parse all the settings. */
746 setting **s = &spec->s;
750 *s = xmalloc (sizeof **s);
751 parse_setting (*s, spec);
752 if (token == ',' || token == ';' || token == '.')
761 /* Parse a list of specifiers for subcommand SBC. */
763 parse_specifiers (subcommand *sbc)
765 specifier **spec = &sbc->spec;
767 if (token == ';' || token == '.')
775 *spec = xmalloc (sizeof **spec);
776 parse_specifier (*spec, sbc);
777 if (token == ';' || token == '.')
780 spec = &(*spec)->next;
782 (*spec)->next = NULL;
785 /* Parse a subcommand into SBC. */
787 parse_subcommand (subcommand *sbc)
789 if (match_token ('*'))
792 error ("Multiple default subcommands.");
796 sbc->arity = ARITY_ONCE_ONLY;
797 if (match_token('+'))
798 sbc->arity = ARITY_MANY;
799 else if (match_token('^'))
800 sbc->arity = ARITY_ONCE_EXACTLY ;
804 sbc->name = xstrdup (tokstr);
808 sbc->type = SBC_PLAIN;
811 if (match_token ('['))
814 sbc->prefix = xstrdup (st_lower (tokstr));
820 sbc->type = SBC_ARRAY;
821 parse_specifiers (sbc);
826 if (match_token ('('))
829 sbc->prefix = xstrdup (st_lower (tokstr));
839 if (match_id ("VAR"))
841 if (match_id ("VARLIST"))
843 if (match_token ('('))
846 sbc->pv_options = xstrdup (tokstr);
852 sbc->pv_options = NULL;
854 sbc->type = SBC_VARLIST;
856 else if (match_id ("INTEGER"))
857 sbc->type = match_id ("LIST") ? SBC_INT_LIST : SBC_INT;
858 else if (match_id ("PINT"))
859 sbc->type = SBC_PINT;
860 else if (match_id ("DOUBLE"))
862 if (match_id ("LIST"))
863 sbc->type = SBC_DBL_LIST;
867 else if (match_id ("STRING"))
868 sbc->type = SBC_STRING;
869 else if (match_id ("CUSTOM"))
870 sbc->type = SBC_CUSTOM;
872 parse_specifiers (sbc);
876 /* Parse all the subcommands. */
878 parse_subcommands (void)
880 subcommand **sbc = &subcommands;
884 *sbc = xmalloc (sizeof **sbc);
887 parse_subcommand (*sbc);
899 #define BASE_INDENT 2 /* Starting indent. */
900 #define INC_INDENT 2 /* Indent increment. */
902 /* Increment the indent. */
903 #define indent() indent += INC_INDENT
904 #define outdent() indent -= INC_INDENT
906 /* Size of the indent from the left margin. */
909 void dump (int, const char *, ...) PRINTF_FORMAT (2, 3);
911 /* Write line FORMAT to the output file, formatted as with printf,
912 indented `indent' characters from the left margin. If INDENTION is
913 greater than 0, indents BASE_INDENT * INDENTION characters after
914 writing the line; if INDENTION is less than 0, dedents BASE_INDENT
915 * INDENTION characters _before_ writing the line. */
917 dump (int indention, const char *format, ...)
923 indent += BASE_INDENT * indention;
926 va_start (args, format);
927 for (i = 0; i < indent; i++)
929 vfprintf (out, format, args);
934 indent += BASE_INDENT * indention;
937 /* Writes a blank line to the output file and adjusts 'indent' by BASE_INDENT
938 * INDENTION characters.
940 (This is only useful because GCC complains about using "" as a format
941 string, for whatever reason.) */
943 dump_blank_line (int indention)
946 indent += BASE_INDENT * indention;
950 /* Write the structure members for specifier SPEC to the output file.
951 SBC is the including subcommand. */
953 dump_specifier_vars (const specifier *spec, const subcommand *sbc)
956 dump (0, "long %s%s;", sbc->prefix, spec->varname);
961 for (s = spec->s; s; s = s->next)
963 if (s->value != VAL_NONE)
965 const char *typename;
967 assert (s->value == VAL_INT || s->value == VAL_DBL
968 || s->value == VAL_STRING);
969 typename = (s->value == VAL_INT ? "long"
970 : s->value == VAL_DBL ? "double"
973 dump (0, "%s %s%s;", typename, sbc->prefix, st_lower (s->valname));
979 /* Returns true if string T is a PSPP keyword, false otherwise. */
981 is_keyword (const char *t)
983 static const char *kw[] =
985 "AND", "OR", "NOT", "EQ", "GE", "GT", "LE", "LT",
986 "NE", "ALL", "BY", "TO", "WITH", 0,
990 for (cp = kw; *cp; cp++)
991 if (!strcmp (t, *cp))
996 /* Transforms a string NAME into a valid C identifier: makes
997 everything lowercase and maps nonalphabetic characters to
998 underscores. Returns a pointer to a static buffer. */
1000 make_identifier (const char *name)
1002 char *p = get_buffer ();
1005 for (cp = p; *name; name++)
1006 if (isalpha ((unsigned char) *name))
1007 *cp++ = tolower ((unsigned char) (*name));
1015 /* Writes the struct and enum declarations for the parser. */
1017 dump_declarations (void)
1021 dump (0, "struct dataset;");
1023 /* Write out enums for all the identifiers in the symbol table. */
1029 /* Note the squirmings necessary to make sure that the last enum
1030 is not followed by a comma, as mandated by ANSI C89. */
1031 for (sym = symtab, f = k = 0; sym; sym = sym->next)
1032 if (!sym->unique && !is_keyword (sym->name))
1036 dump (0, "/* Settings for subcommand specifiers. */");
1043 buf = xmalloc (1024);
1045 dump (0, "%s", buf);
1048 sprintf (buf, "%s%s,", st_upper (prefix), sym->name);
1052 sprintf (buf, "%s%s = 1000,", st_upper (prefix), sym->name);
1057 buf[strlen (buf) - 1] = 0;
1058 dump (0, "%s", buf);
1064 dump_blank_line (-1);
1068 /* Write out some type definitions */
1070 dump (0, "#define MAXLISTS 10");
1074 /* For every array subcommand, write out the associated enumerated
1079 for (sbc = subcommands; sbc; sbc = sbc->next)
1080 if (sbc->type == SBC_ARRAY && sbc->narray)
1082 dump (0, "/* Array indices for %s subcommand. */", sbc->name);
1090 for (spec = sbc->spec; spec; spec = spec->next)
1091 dump (0, "%s%s%s = %d,",
1092 st_upper (prefix), st_upper (sbc->prefix),
1093 st_upper (spec->varname), spec->index);
1095 dump (0, "%s%scount", st_upper (prefix), st_upper (sbc->prefix));
1098 dump_blank_line (-1);
1103 /* Write out structure declaration. */
1107 dump (0, "/* %s structure. */", cmdname);
1108 dump (1, "struct cmd_%s", make_identifier (cmdname));
1110 for (sbc = subcommands; sbc; sbc = sbc->next)
1114 if (sbc != subcommands)
1115 dump_blank_line (0);
1117 dump (0, "/* %s subcommand. */", sbc->name);
1118 dump (0, "int sbc_%s;", st_lower (sbc->name));
1127 for (spec = sbc->spec; spec; spec = spec->next)
1131 if (sbc->type == SBC_PLAIN)
1132 dump (0, "long int %s%s;", st_lower (sbc->prefix),
1136 dump (0, "int a_%s[%s%scount];",
1137 st_lower (sbc->name),
1139 st_upper (sbc->prefix)
1146 dump_specifier_vars (spec, sbc);
1152 dump (0, "size_t %sn_%s;", st_lower (sbc->prefix),
1153 st_lower (sbc->name));
1154 dump (0, "const struct variable **%sv_%s;", st_lower (sbc->prefix),
1155 st_lower (sbc->name));
1159 dump (0, "const struct variable *%sv_%s;", st_lower (sbc->prefix),
1160 st_lower (sbc->name));
1164 dump (0, "char *s_%s;", st_lower (sbc->name));
1169 dump (0, "long n_%s[MAXLISTS];", st_lower (sbc->name));
1173 dump (0, "double n_%s[MAXLISTS];", st_lower (sbc->name));
1177 dump (0, "subc_list_double dl_%s[MAXLISTS];",
1178 st_lower(sbc->name));
1182 dump (0, "subc_list_int il_%s[MAXLISTS];",
1183 st_lower(sbc->name));
1193 dump_blank_line (-1);
1196 /* Write out prototypes for custom_*() functions as necessary. */
1201 for (sbc = subcommands; sbc; sbc = sbc->next)
1202 if (sbc->type == SBC_CUSTOM)
1207 dump (0, "/* Prototype for custom subcommands of %s. */",
1210 dump (0, "static int %scustom_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
1211 st_lower (prefix), st_lower (sbc->name),
1212 make_identifier (cmdname));
1216 dump_blank_line (0);
1219 /* Prototypes for parsing and freeing functions. */
1221 dump (0, "/* Command parsing functions. */");
1222 dump (0, "static int parse_%s (struct lexer *, struct dataset *, struct cmd_%s *, void *);",
1223 make_identifier (cmdname), make_identifier (cmdname));
1224 dump (0, "static void free_%s (struct cmd_%s *);",
1225 make_identifier (cmdname), make_identifier (cmdname));
1226 dump_blank_line (0);
1230 /* Writes out code to initialize all the variables that need
1231 initialization for particular specifier SPEC inside subcommand SBC. */
1233 dump_specifier_init (const specifier *spec, const subcommand *sbc)
1241 st_upper (prefix), find_symbol (spec->def->con)->name);
1244 dump (0, "p->%s%s = %s;", sbc->prefix, spec->varname, s);
1250 for (s = spec->s; s; s = s->next)
1252 if (s->value != VAL_NONE)
1256 assert (s->value == VAL_INT || s->value == VAL_DBL
1257 || s->value == VAL_STRING);
1258 init = (s->value == VAL_INT ? "LONG_MIN"
1259 : s->value == VAL_DBL ? "SYSMIS"
1262 dump (0, "p->%s%s = %s;", sbc->prefix, st_lower (s->valname), init);
1268 /* Write code to initialize all variables. */
1270 dump_vars_init (int persistent)
1272 /* Loop through all the subcommands. */
1276 for (sbc = subcommands; sbc; sbc = sbc->next)
1280 dump (0, "p->sbc_%s = 0;", st_lower (sbc->name));
1289 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1290 dump (0, "subc_list_%s_create(&p->%cl_%s[i]) ;",
1291 sbc->type == SBC_INT_LIST ? "int" : "double",
1292 sbc->type == SBC_INT_LIST ? 'i' : 'd',
1293 st_lower (sbc->name)
1301 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1302 dump (0, "p->n_%s[i] = SYSMIS;", st_lower (sbc->name));
1315 for (spec = sbc->spec; spec; spec = spec->next)
1316 if (spec->s == NULL)
1318 if (sbc->type == SBC_PLAIN)
1319 dump (0, "p->%s%s = 0;", sbc->prefix, spec->varname);
1322 dump (0, "memset (p->a_%s, 0, sizeof p->a_%s);",
1323 st_lower (sbc->name), st_lower (sbc->name));
1328 dump_specifier_init (spec, sbc);
1333 dump (0, "p->%sn_%s = 0;",
1334 st_lower (sbc->prefix), st_lower (sbc->name));
1335 dump (0, "p->%sv_%s = NULL;",
1336 st_lower (sbc->prefix), st_lower (sbc->name));
1340 dump (0, "p->%sv_%s = NULL;",
1341 st_lower (sbc->prefix), st_lower (sbc->name));
1345 dump (0, "p->s_%s = NULL;", st_lower (sbc->name));
1352 dump (1, "for (i = 0; i < MAXLISTS; ++i)");
1353 dump (0, "p->n_%s[i] = LONG_MIN;", st_lower (sbc->name));
1365 /* Return a pointer to a static buffer containing an expression that
1366 will match token T. */
1368 make_match (const char *t)
1378 sprintf (s, "lex_match (lexer, T_%s)", t);
1379 else if (!strcmp (t, "ON") || !strcmp (t, "YES"))
1380 strcpy (s, "(lex_match_id (lexer, \"ON\") || lex_match_id (lexer, \"YES\") "
1381 "|| lex_match_id (lexer, \"TRUE\"))");
1382 else if (!strcmp (t, "OFF") || !strcmp (t, "NO"))
1383 strcpy (s, "(lex_match_id (lexer, \"OFF\") || lex_match_id (lexer, \"NO\") "
1384 "|| lex_match_id (lexer, \"FALSE\"))");
1385 else if (isdigit ((unsigned char) t[0]))
1386 sprintf (s, "lex_match_int (lexer, %s)", t);
1387 else if (strchr (t, hyphen_proxy))
1389 char *c = unmunge (t);
1390 sprintf (s, "lex_match_phrase (lexer, \"%s\")", c);
1394 sprintf (s, "lex_match_id (lexer, \"%s\")", t);
1399 /* Write out the parsing code for specifier SPEC within subcommand
1402 dump_specifier_parse (const specifier *spec, const subcommand *sbc)
1406 if (spec->omit_kw && spec->omit_kw->next)
1407 error ("Omittable setting is not last setting in `%s' specifier.",
1409 if (spec->omit_kw && spec->omit_kw->parent->next)
1410 error ("Default specifier is not in last specifier in `%s' "
1411 "subcommand.", sbc->name);
1413 for (s = spec->s; s; s = s->next)
1415 int first = spec == sbc->spec && s == spec->s;
1417 /* Match the setting's keyword. */
1418 if (spec->omit_kw == s)
1425 dump (1, "%s;", make_match (s->specname));
1428 dump (1, "%sif (%s)", first ? "" : "else ",
1429 make_match (s->specname));
1432 /* Handle values. */
1433 if (s->value == VAL_NONE)
1434 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1435 st_upper (prefix), find_symbol (s->con)->name);
1438 if (spec->omit_kw != s)
1443 dump (0, "p->%s%s = %s%s;", sbc->prefix, spec->varname,
1444 st_upper (prefix), find_symbol (s->con)->name);
1446 if (sbc->type == SBC_ARRAY)
1447 dump (0, "p->a_%s[%s%s%s] = 1;",
1448 st_lower (sbc->name),
1449 st_upper (prefix), st_upper (sbc->prefix),
1450 st_upper (spec->varname));
1454 if (s->valtype == VT_PAREN)
1458 dump (1, "if (lex_match (lexer, T_LPAREN))");
1463 dump (1, "if (!lex_match (lexer, T_LPAREN))");
1465 dump (0, "lex_error_expecting (lexer, \"`('\");");
1466 dump (0, "goto lossage;");
1472 if (s->value == VAL_INT)
1474 dump (1, "if (!lex_force_int (lexer))");
1475 dump (0, "goto lossage;");
1476 dump (-1, "p->%s%s = lex_integer (lexer);",
1477 sbc->prefix, st_lower (s->valname));
1479 else if (s->value == VAL_DBL)
1481 dump (1, "if (!lex_force_num (lexer))");
1482 dump (0, "goto lossage;");
1483 dump (-1, "p->%s%s = lex_tokval (lexer);", sbc->prefix,
1484 st_lower (s->valname));
1486 else if (s->value == VAL_STRING)
1488 dump (1, "if (!lex_force_string_or_id (lexer))");
1489 dump (0, "goto lossage;");
1490 dump (-1, "free (p->%s%s);", sbc->prefix, st_lower (s->valname));
1491 dump (0, "p->%s%s = ss_xstrdup (ss_tokss (lexer));",
1492 sbc->prefix, st_lower (s->valname));
1501 str = xmalloc (MAX_TOK_LEN);
1502 str2 = xmalloc (MAX_TOK_LEN);
1503 sprintf (str2, "p->%s%s", sbc->prefix, st_lower (s->valname));
1504 sprintf (str, s->restriction, str2, str2, str2, str2,
1505 str2, str2, str2, str2);
1506 dump (1, "if (!(%s))", str);
1512 dump (0, "lex_error (lexer, NULL);");
1513 dump (0, "goto lossage;");
1518 dump (0, "lex_get (lexer);");
1520 if (s->valtype == VT_PAREN)
1522 dump (1, "if (!lex_force_match (lexer, T_RPAREN))");
1523 dump (0, "goto lossage;");
1532 if (s != spec->omit_kw)
1536 if (s == spec->omit_kw)
1545 /* Write out the code to parse subcommand SBC. */
1547 dump_subcommand (const subcommand *sbc)
1549 if (sbc->type == SBC_PLAIN || sbc->type == SBC_ARRAY)
1553 dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1559 for (count = 0, spec = sbc->spec; spec; spec = spec->next)
1562 dump_specifier_parse (spec, sbc);
1566 dump (1, "%sif (%s)", spec != sbc->spec ? "else " : "",
1567 make_match (st_upper (spec->varname)));
1568 if (sbc->type == SBC_PLAIN)
1569 dump (0, "p->%s%s = 1;", st_lower (sbc->prefix),
1572 dump (0, "p->a_%s[%s%s%s] = 1;",
1573 st_lower (sbc->name),
1574 st_upper (prefix), st_upper (sbc->prefix),
1575 st_upper (spec->varname));
1585 /* This code first finds the last specifier in sbc. Then it
1586 finds the last setting within that last specifier. Either
1587 or both might be NULL. */
1600 if (spec && (!spec->s || !spec->omit_kw))
1604 dump (0, "lex_error (lexer, NULL);");
1605 dump (0, "goto lossage;");
1611 dump (0, "lex_match (lexer, T_COMMA);");
1615 else if (sbc->type == SBC_VARLIST)
1617 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1619 st_lower (sbc->prefix), st_lower (sbc->name),
1620 st_lower (sbc->prefix), st_lower (sbc->name),
1621 sbc->pv_options ? " |" : "",
1622 sbc->pv_options ? sbc->pv_options : "");
1623 dump (0, "goto lossage;");
1626 else if (sbc->type == SBC_VAR)
1628 dump (0, "p->%sv_%s = parse_variable (lexer, dataset_dict (ds));",
1629 st_lower (sbc->prefix), st_lower (sbc->name));
1630 dump (1, "if (!p->%sv_%s)",
1631 st_lower (sbc->prefix), st_lower (sbc->name));
1632 dump (0, "goto lossage;");
1635 else if (sbc->type == SBC_STRING)
1637 dump (1, "if (!lex_force_string (lexer))");
1638 dump (0, "return false;");
1640 dump (0, "free(p->s_%s);", st_lower(sbc->name));
1641 dump (0, "p->s_%s = ss_xstrdup (lex_tokss (lexer));",
1642 st_lower (sbc->name));
1643 dump (0, "lex_get (lexer);");
1645 else if (sbc->type == SBC_DBL)
1647 dump (1, "if (!lex_force_num (lexer))");
1648 dump (0, "goto lossage;");
1649 dump (-1, "p->n_%s[p->sbc_%s - 1] = lex_number (lexer);",
1650 st_lower (sbc->name), st_lower (sbc->name));
1651 dump (0, "lex_get(lexer);");
1653 else if (sbc->type == SBC_INT)
1657 dump (1, "if (!lex_force_int (lexer))");
1658 dump (0, "goto lossage;");
1659 dump (-1, "x = lex_integer (lexer);");
1660 dump (0, "lex_get(lexer);");
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 (lexer, T_LPAREN);");
1667 dump (1, "if (!lex_force_int (lexer))");
1668 dump (0, "goto lossage;");
1669 dump (-1, "p->n_%s = lex_integer (lexer);", st_lower (sbc->name));
1670 dump (0, "lex_match (lexer, T_RPAREN);");
1672 else if (sbc->type == SBC_DBL_LIST || sbc->type == SBC_INT_LIST)
1674 dump (0, "if (p->sbc_%s > MAXLISTS)",st_lower(sbc->name));
1676 dump (0, "subc_list_error (lexer, \"%s\", MAXLISTS);",
1677 st_lower(sbc->name));
1678 dump (0, "goto lossage;");
1681 dump (1, "while (lex_token (lexer) != T_SLASH && lex_token (lexer) != T_ENDCMD)");
1683 dump (0, "lex_match (lexer, T_COMMA);");
1684 dump (0, "if (!lex_force_num (lexer))");
1686 dump (0, "goto lossage;");
1689 dump (0, "subc_list_%s_push (&p->%cl_%s[p->sbc_%s-1], lex_number (lexer));",
1690 sbc->type == SBC_INT_LIST ? "int" : "double",
1691 sbc->type == SBC_INT_LIST ? 'i' : 'd',
1692 st_lower (sbc->name), st_lower (sbc->name));
1694 dump (0, "lex_get (lexer);");
1698 else if (sbc->type == SBC_CUSTOM)
1700 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1701 st_lower (prefix), st_lower (sbc->name));
1703 dump (1, "case 0:");
1704 dump (0, "goto lossage;");
1705 dump (-1, "case 1:");
1708 dump (-1, "case 2:");
1710 dump (0, "lex_error (lexer, NULL);");
1711 dump (0, "goto lossage;");
1712 dump (-1, "default:");
1714 dump (0, "NOT_REACHED ();");
1720 /* Write out entire parser. */
1722 dump_parser (int persistent)
1728 dump (0, "static int");
1729 dump (0, "parse_%s (struct lexer *lexer, struct dataset *ds%s, struct cmd_%s *p, void *aux UNUSED)",
1730 make_identifier (cmdname),
1731 (def && (def->type == SBC_VARLIST || def->type == SBC_CUSTOM))?"":" UNUSED",
1732 make_identifier (cmdname));
1735 dump_vars_init (persistent);
1737 dump (1, "for (;;)");
1741 if (def && (def->type == SBC_VARLIST))
1743 if (def->type == SBC_VARLIST)
1744 dump (1, "if (lex_token (lexer) == T_ID "
1745 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) != NULL "
1746 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1749 dump (0, "if ((lex_token (lexer) == T_ID "
1750 "&& dict_lookup_var (dataset_dict (ds), lex_tokcstr (lexer)) "
1751 "&& lex_next_token (lexer, 1) != T_EQUALS)");
1752 dump (1, " || token == T_ALL)");
1755 dump (0, "p->sbc_%s++;", st_lower (def->name));
1756 dump (1, "if (!parse_variables_const (lexer, dataset_dict (ds), &p->%sv_%s, &p->%sn_%s, "
1758 st_lower (def->prefix), st_lower (def->name),
1759 st_lower (def->prefix), st_lower (def->name));
1760 dump (0, "goto lossage;");
1765 else if (def && def->type == SBC_CUSTOM)
1767 dump (1, "switch (%scustom_%s (lexer, ds, p, aux))",
1768 st_lower (prefix), st_lower (def->name));
1770 dump (1, "case 0:");
1771 dump (0, "goto lossage;");
1772 dump (-1, "case 1:");
1774 dump (0, "p->sbc_%s++;", st_lower (def->name));
1775 dump (0, "continue;");
1776 dump (-1, "case 2:");
1779 dump (-1, "default:");
1781 dump (0, "NOT_REACHED ();");
1789 for (sbc = subcommands; sbc; sbc = sbc->next)
1791 dump (1, "%sif (%s)", f ? "else " : "", make_match (sbc->name));
1795 dump (0, "lex_match (lexer, T_EQUALS);");
1796 dump (0, "p->sbc_%s++;", st_lower (sbc->name));
1797 if (sbc->arity != ARITY_MANY)
1799 dump (1, "if (p->sbc_%s > 1)", st_lower (sbc->name));
1801 dump (0, "lex_sbc_only_once (\"%s\");", sbc->name);
1802 dump (0, "goto lossage;");
1806 dump_subcommand (sbc);
1813 /* Now deal with the /ALGORITHM subcommand implicit to all commands */
1814 dump(1,"else if (settings_get_syntax () != COMPATIBLE && lex_match_id(lexer, \"ALGORITHM\"))");
1817 dump (0, "lex_match (lexer, T_EQUALS);");
1819 dump(1,"if (lex_match_id(lexer, \"COMPATIBLE\"))");
1820 dump(0,"settings_set_cmd_algorithm (COMPATIBLE);");
1822 dump(1,"else if (lex_match_id(lexer, \"ENHANCED\"))");
1823 dump(0,"settings_set_cmd_algorithm (ENHANCED);");
1830 dump (1, "if (!lex_match (lexer, T_SLASH))");
1834 dump_blank_line (0);
1835 dump (1, "if (lex_token (lexer) != T_ENDCMD)");
1837 dump (0, "lex_error (lexer, _(\"expecting end of command\"));");
1838 dump (0, "goto lossage;");
1840 dump_blank_line (0);
1845 /* Check that mandatory subcommands have been specified */
1848 for (sbc = subcommands; sbc; sbc = sbc->next)
1851 if (sbc->arity == ARITY_ONCE_EXACTLY)
1853 dump (0, "if (0 == p->sbc_%s)", st_lower (sbc->name));
1855 dump (0, "lex_sbc_missing (\"%s\");", sbc->name);
1856 dump (0, "goto lossage;");
1858 dump_blank_line (0);
1863 dump (-1, "return true;");
1864 dump_blank_line (0);
1865 dump (-1, "lossage:");
1867 dump (0, "free_%s (p);", make_identifier (cmdname));
1868 dump (0, "return false;");
1870 dump_blank_line (0);
1874 /* Write the output file header. */
1879 dump (0, "/* %s\t\t-*- mode: c; buffer-read-only: t -*-", ofn);
1880 dump_blank_line (0);
1881 dump (0, " Generated by q2c from %s.", ifn);
1882 dump (0, " Do not modify!");
1886 /* Write out commands to free variable state. */
1888 dump_free (int persistent)
1898 for (sbc = subcommands; sbc; sbc = sbc->next)
1899 used = (sbc->type == SBC_STRING
1900 || sbc->type == SBC_DBL_LIST
1901 || sbc->type == SBC_INT_LIST);
1904 dump (0, "static void");
1905 dump (0, "free_%s (struct cmd_%s *p%s)", make_identifier (cmdname),
1906 make_identifier (cmdname), used ? "" : " UNUSED");
1912 for (sbc = subcommands; sbc; sbc = sbc->next)
1917 dump (0, "free (p->v_%s);", st_lower (sbc->name));
1920 dump (0, "free (p->s_%s);", st_lower (sbc->name));
1926 dump (2, "for(i = 0; i < MAXLISTS ; ++i)");
1927 dump (1, "subc_list_%s_destroy(&p->%cl_%s[i]);",
1928 sbc->type == SBC_INT_LIST ? "int" : "double",
1929 sbc->type == SBC_INT_LIST ? 'i' : 'd',
1930 st_lower (sbc->name));
1939 for (spec = sbc->spec; spec; spec = spec->next)
1940 for (s = spec->s; s; s = s->next)
1941 if (s->value == VAL_STRING)
1942 dump (0, "free (p->%s%s);",
1943 sbc->prefix, st_lower (s->valname));
1957 /* Returns the name of a directive found on the current input line, if
1958 any, or a null pointer if none found. */
1960 recognize_directive (void)
1962 static char directive[16];
1966 if (strncmp (sp, "/*", 2))
1968 sp = skip_ws (sp + 2);
1973 ep = strchr (sp, ')');
1979 memcpy (directive, sp, ep - sp);
1980 directive[ep - sp] = '\0';
1985 main (int argc, char *argv[])
1987 program_name = argv[0];
1989 fail ("Syntax: q2c input.q output.c");
1992 in = fopen (ifn, "r");
1994 fail ("%s: open: %s.", ifn, strerror (errno));
1997 out = fopen (ofn, "w");
1999 fail ("%s: open: %s.", ofn, strerror (errno));
2002 buf = xmalloc (MAX_LINE_LEN);
2003 tokstr = xmalloc (MAX_TOK_LEN);
2009 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2012 const char *directive = recognize_directive ();
2013 if (directive == NULL)
2015 dump (0, "%s", buf);
2019 dump (0, "#line %d \"%s\"", oln + 1, ofn);
2020 if (!strcmp (directive, "specification"))
2022 /* Skip leading slash-star line. */
2028 /* Skip trailing star-slash line. */
2031 else if (!strcmp (directive, "headers"))
2035 dump (0, "#include <stdlib.h>");
2036 dump_blank_line (0);
2038 dump (0, "#include \"data/settings.h\"");
2039 dump (0, "#include \"data/variable.h\"");
2040 dump (0, "#include \"language/lexer/lexer.h\"");
2041 dump (0, "#include \"language/lexer/subcommand-list.h\"");
2042 dump (0, "#include \"language/lexer/variable-parser.h\"");
2043 dump (0, "#include \"libpspp/assertion.h\"");
2044 dump (0, "#include \"libpspp/cast.h\"");
2045 dump (0, "#include \"libpspp/message.h\"");
2046 dump (0, "#include \"libpspp/str.h\"");
2047 dump_blank_line (0);
2049 dump (0, "#include \"gl/xalloc.h\"");
2050 dump_blank_line (0);
2052 else if (!strcmp (directive, "declarations"))
2053 dump_declarations ();
2054 else if (!strcmp (directive, "functions"))
2059 else if (!strcmp (directive, "_functions"))
2065 error ("unknown directive `%s'", directive);
2067 dump (0, "#line %d \"%s\"", ln + 1, ifn);
2070 return EXIT_SUCCESS;